home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir43 / perldoss.zip / EVAL.C < prev    next >
C/C++ Source or Header  |  1991-11-28  |  73KB  |  3,005 lines
  1. /* $RCSfile: eval.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 17:15:21 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  * $Log:    eval.c,v $
  9.  * Revision 4.0.1.3  91/11/05  17:15:21  lwall
  10.  * patch11: prepared for ctype implementations that don't define isascii()
  11.  * patch11: various portability fixes
  12.  * patch11: added sort {} LIST
  13.  * patch11: added eval {}
  14.  * patch11: sysread() in socket was substituting recv()
  15.  * patch11: a last statement outside any block caused occasional core dumps
  16.  * patch11: missing arguments caused core dump in -D8 code
  17.  * patch11: eval 'stuff' now optimized to eval {stuff}
  18.  *
  19.  * Revision 4.0.1.2  91/06/07  11:07:23  lwall
  20.  * patch4: new copyright notice
  21.  * patch4: length($`), length($&), length($') now optimized to avoid string copy
  22.  * patch4: assignment wasn't correctly de-tainting the assigned variable.
  23.  * patch4: default top-of-form format is now FILEHANDLE_TOP
  24.  * patch4: added $^P variable to control calling of perldb routines
  25.  * patch4: taintchecks could improperly modify parent in vfork()
  26.  * patch4: many, many itty-bitty portability fixes
  27.  *
  28.  * Revision 4.0.1.1  91/04/11  17:43:48  lwall
  29.  * patch1: fixed failed fork to return undef as documented
  30.  * patch1: reduced maximum branch distance in eval.c
  31.  *
  32.  * Revision 4.0  91/03/20  01:16:48  lwall
  33.  * 4.0 baseline.
  34.  *
  35.  */
  36.  
  37.  
  38. #include "EXTERN.h"
  39. #include "perl.h"
  40.  
  41.  
  42. #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  43. #include <signal.h>
  44. #endif
  45.  
  46.  
  47. #ifdef I_FCNTL
  48. #include <fcntl.h>
  49. #endif
  50. #ifdef I_SYS_FILE
  51. #include <sys/file.h>
  52. #endif
  53. #ifdef I_VFORK
  54. #   include <vfork.h>
  55. #endif
  56.  
  57.  
  58. #ifdef VOIDSIG
  59. static void (*ihand)();
  60. static void (*qhand)();
  61. #else
  62. static int (*ihand)();
  63. static int (*qhand)();
  64. #endif
  65.  
  66.  
  67. ARG *debarg;
  68. STR str_args;
  69. static STAB *stab2;
  70. static STIO *stio;
  71. static struct lstring *lstr;
  72. static int old_rschar;
  73. static int old_rslen;
  74.  
  75.  
  76. double sin(), cos(), atan2(), pow();
  77.  
  78.  
  79. char *getlogin();
  80.  
  81.  
  82. int
  83. eval(arg,gimme,sp)
  84. register ARG *arg;
  85. int gimme;
  86. register int sp;
  87. {
  88.     register STR *str;
  89.     register int anum;
  90.     register int optype;
  91.     register STR **st;
  92.     int maxarg;
  93.     double value;
  94.     register char *tmps;
  95.     char *tmps2;
  96.     int argflags;
  97.     int argtype;
  98.     union argptr argptr;
  99.     int arglast[8];    /* highest sp for arg--valid only for non-O_LIST args */
  100.     unsigned long tmplong;
  101.     long when;
  102.     FILE *fp;
  103.     STR *tmpstr;
  104.     FCMD *form;
  105.     STAB *stab;
  106.     ARRAY *ary;
  107.     bool assigning = FALSE;
  108.     double exp(), log(), sqrt(), modf();
  109.     char *crypt(), *getenv();
  110.     extern void grow_dlevel();
  111.  
  112.  
  113.     if (!arg)
  114.     goto say_undef;
  115.     optype = arg->arg_type;
  116.     maxarg = arg->arg_len;
  117.     arglast[0] = sp;
  118.     str = arg->arg_ptr.arg_str;
  119.     if (sp + maxarg > stack->ary_max)
  120.     astore(stack, sp + maxarg, Nullstr);
  121.     st = stack->ary_array;
  122.  
  123.  
  124. #ifdef DEBUGGING
  125.     if (debug) {
  126.     if (debug & 8) {
  127.         deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg);
  128.     }
  129.     debname[dlevel] = opname[optype][0];
  130.     debdelim[dlevel] = ':';
  131.     if (++dlevel >= dlmax)
  132.         grow_dlevel();
  133.     }
  134. #endif
  135.  
  136.  
  137.     for (anum = 1; anum <= maxarg; anum++) {
  138.     argflags = arg[anum].arg_flags;
  139.     argtype = arg[anum].arg_type;
  140.     argptr = arg[anum].arg_ptr;
  141.       re_eval:
  142.     switch (argtype) {
  143.     default:
  144.         st[++sp] = &str_undef;
  145. #ifdef DEBUGGING
  146.         tmps = "NULL";
  147. #endif
  148.         break;
  149.     case A_EXPR:
  150. #ifdef DEBUGGING
  151.         if (debug & 8) {
  152.         tmps = "EXPR";
  153.         deb("%d.EXPR =>\n",anum);
  154.         }
  155. #endif
  156.         sp = eval(argptr.arg_arg,
  157.         (argflags & AF_ARYOK) ? G_ARRAY : G_SCALAR, sp);
  158.         if (sp + (maxarg - anum) > stack->ary_max)
  159.         astore(stack, sp + (maxarg - anum), Nullstr);
  160.         st = stack->ary_array;    /* possibly reallocated */
  161.         break;
  162.     case A_CMD:
  163. #ifdef DEBUGGING
  164.         if (debug & 8) {
  165.         tmps = "CMD";
  166.         deb("%d.CMD (%lx) =>\n",anum,argptr.arg_cmd);
  167.         }
  168. #endif
  169.         sp = cmd_exec(argptr.arg_cmd, gimme, sp);
  170.         if (sp + (maxarg - anum) > stack->ary_max)
  171.         astore(stack, sp + (maxarg - anum), Nullstr);
  172.         st = stack->ary_array;    /* possibly reallocated */
  173.         break;
  174.     case A_LARYSTAB:
  175.         ++sp;
  176.         switch (optype) {
  177.         case O_ITEM2: argtype = 2; break;
  178.         case O_ITEM3: argtype = 3; break;
  179.         default:      argtype = anum; break;
  180.         }
  181.         str = afetch(stab_array(argptr.arg_stab),
  182.         arg[argtype].arg_len - arybase, TRUE);
  183. #ifdef DEBUGGING
  184.         if (debug & 8) {
  185.         (void)sprintf(buf,"LARYSTAB $%s[%d]",stab_name(argptr.arg_stab),
  186.             arg[argtype].arg_len);
  187.         tmps = buf;
  188.         }
  189. #endif
  190.         goto do_crement;
  191.     case A_ARYSTAB:
  192.         switch (optype) {
  193.         case O_ITEM2: argtype = 2; break;
  194.         case O_ITEM3: argtype = 3; break;
  195.         default:      argtype = anum; break;
  196.         }
  197.         st[++sp] = afetch(stab_array(argptr.arg_stab),
  198.         arg[argtype].arg_len - arybase, FALSE);
  199. #ifdef DEBUGGING
  200.         if (debug & 8) {
  201.         (void)sprintf(buf,"ARYSTAB $%s[%d]",stab_name(argptr.arg_stab),
  202.             arg[argtype].arg_len);
  203.         tmps = buf;
  204.         }
  205. #endif
  206.         break;
  207.     case A_STAR:
  208.         stab = argptr.arg_stab;
  209.         st[++sp] = (STR*)stab;
  210.         if (!stab_xarray(stab))
  211.         aadd(stab);
  212.         if (!stab_xhash(stab))
  213.         hadd(stab);
  214.         if (!stab_io(stab))
  215.         stab_io(stab) = stio_new();
  216. #ifdef DEBUGGING
  217.         if (debug & 8) {
  218.         (void)sprintf(buf,"STAR *%s",stab_name(argptr.arg_stab));
  219.         tmps = buf;
  220.         }
  221. #endif
  222.         break;
  223.     case A_LSTAR:
  224.         str = st[++sp] = (STR*)argptr.arg_stab;
  225. #ifdef DEBUGGING
  226.         if (debug & 8) {
  227.         (void)sprintf(buf,"LSTAR *%s",stab_name(argptr.arg_stab));
  228.         tmps = buf;
  229.         }
  230. #endif
  231.         break;
  232.     case A_STAB:
  233.         st[++sp] = STAB_STR(argptr.arg_stab);
  234. #ifdef DEBUGGING
  235.         if (debug & 8) {
  236.         (void)sprintf(buf,"STAB $%s",stab_name(argptr.arg_stab));
  237.         tmps = buf;
  238.         }
  239. #endif
  240.         break;
  241.     case A_LENSTAB:
  242.         str_numset(str, (double)STAB_LEN(argptr.arg_stab));
  243.         st[++sp] = str;
  244. #ifdef DEBUGGING
  245.         if (debug & 8) {
  246.         (void)sprintf(buf,"LENSTAB $%s",stab_name(argptr.arg_stab));
  247.         tmps = buf;
  248.         }
  249. #endif
  250.         break;
  251.     case A_LEXPR:
  252. #ifdef DEBUGGING
  253.         if (debug & 8) {
  254.         tmps = "LEXPR";
  255.         deb("%d.LEXPR =>\n",anum);
  256.         }
  257. #endif
  258.         if (argflags & AF_ARYOK) {
  259.         sp = eval(argptr.arg_arg, G_ARRAY, sp);
  260.         if (sp + (maxarg - anum) > stack->ary_max)
  261.             astore(stack, sp + (maxarg - anum), Nullstr);
  262.         st = stack->ary_array;    /* possibly reallocated */
  263.         }
  264.         else {
  265.         sp = eval(argptr.arg_arg, G_SCALAR, sp);
  266.         st = stack->ary_array;    /* possibly reallocated */
  267.         str = st[sp];
  268.         goto do_crement;
  269.         }
  270.         break;
  271.     case A_LVAL:
  272. #ifdef DEBUGGING
  273.         if (debug & 8) {
  274.         (void)sprintf(buf,"LVAL $%s",stab_name(argptr.arg_stab));
  275.         tmps = buf;
  276.         }
  277. #endif
  278.         ++sp;
  279.         str = STAB_STR(argptr.arg_stab);
  280.         if (!str)
  281.         fatal("panic: A_LVAL");
  282.       do_crement:
  283.         assigning = TRUE;
  284.         if (argflags & AF_PRE) {
  285.         if (argflags & AF_UP)
  286.             str_inc(str);
  287.         else
  288.             str_dec(str);
  289.         STABSET(str);
  290.         st[sp] = str;
  291.         str = arg->arg_ptr.arg_str;
  292.         }
  293.         else if (argflags & AF_POST) {
  294.         st[sp] = str_mortal(str);
  295.         if (argflags & AF_UP)
  296.             str_inc(str);
  297.         else
  298.             str_dec(str);
  299.         STABSET(str);
  300.         str = arg->arg_ptr.arg_str;
  301.         }
  302.         else
  303.         st[sp] = str;
  304.         break;
  305.     case A_LARYLEN:
  306.         ++sp;
  307.         stab = argptr.arg_stab;
  308.         str = stab_array(argptr.arg_stab)->ary_magic;
  309.         if (optype != O_SASSIGN || argflags & (AF_PRE|AF_POST))
  310.         str_numset(str,(double)(stab_array(stab)->ary_fill+arybase));
  311. #ifdef DEBUGGING
  312.         tmps = "LARYLEN";
  313. #endif
  314.         if (!str)
  315.         fatal("panic: A_LEXPR");
  316.         goto do_crement;
  317.     case A_ARYLEN:
  318.         stab = argptr.arg_stab;
  319.         st[++sp] = stab_array(stab)->ary_magic;
  320.         str_numset(st[sp],(double)(stab_array(stab)->ary_fill+arybase));
  321. #ifdef DEBUGGING
  322.         tmps = "ARYLEN";
  323. #endif
  324.         break;
  325.     case A_SINGLE:
  326.         st[++sp] = argptr.arg_str;
  327. #ifdef DEBUGGING
  328.         tmps = "SINGLE";
  329. #endif
  330.         break;
  331.     case A_DOUBLE:
  332.         (void) interp(str,argptr.arg_str,sp);
  333.         st = stack->ary_array;
  334.         st[++sp] = str;
  335. #ifdef DEBUGGING
  336.         tmps = "DOUBLE";
  337. #endif
  338.         break;
  339.     case A_BACKTICK:
  340.         tmps = str_get(interp(str,argptr.arg_str,sp));
  341.         st = stack->ary_array;
  342. #ifdef TAINT
  343.         taintproper("Insecure dependency in ``");
  344. #endif
  345.         fp = mypopen(tmps,"r");
  346.         str_set(str,"");
  347.         if (fp) {
  348.         if (gimme == G_SCALAR) {
  349.             while (str_gets(str,fp,str->str_cur) != Nullch)
  350.             /*SUPPRESS 530*/
  351.             ;
  352.         }
  353.         else {
  354.             for (;;) {
  355.             if (++sp > stack->ary_max) {
  356.                 astore(stack, sp, Nullstr);
  357.                 st = stack->ary_array;
  358.             }
  359.             str = st[sp] = Str_new(56,80);
  360.             if (str_gets(str,fp,0) == Nullch) {
  361.                 sp--;
  362.                 break;
  363.             }
  364.             if (str->str_len - str->str_cur > 20) {
  365.                 str->str_len = str->str_cur+1;
  366.                 Renew(str->str_ptr, str->str_len, char);
  367.             }
  368.             str_2mortal(str);
  369.             }
  370.         }
  371.         statusvalue = mypclose(fp);
  372.         }
  373.         else
  374.         statusvalue = -1;
  375.  
  376.  
  377.         if (gimme == G_SCALAR)
  378.         st[++sp] = str;
  379. #ifdef DEBUGGING
  380.         tmps = "BACK";
  381. #endif
  382.         break;
  383.     case A_WANTARRAY:
  384.         {
  385.         if (curcsv->wantarray == G_ARRAY)
  386.             st[++sp] = &str_yes;
  387.         else
  388.             st[++sp] = &str_no;
  389.         }
  390. #ifdef DEBUGGING
  391.         tmps = "WANTARRAY";
  392. #endif
  393.         break;
  394.     case A_INDREAD:
  395.         last_in_stab = stabent(str_get(STAB_STR(argptr.arg_stab)),TRUE);
  396.         old_rschar = rschar;
  397.         old_rslen = rslen;
  398.         goto do_read;
  399.     case A_GLOB:
  400.         argflags |= AF_POST;    /* enable newline chopping */
  401.         last_in_stab = argptr.arg_stab;
  402.         old_rschar = rschar;
  403.         old_rslen = rslen;
  404.         rslen = 1;
  405. #ifdef MSDOS
  406.         rschar = 0;
  407. #else
  408. #ifdef CSH
  409.         rschar = 0;
  410. #else
  411.         rschar = '\n';
  412. #endif    /* !CSH */
  413. #endif    /* !MSDOS */
  414.         goto do_read;
  415.     case A_READ:
  416.         last_in_stab = argptr.arg_stab;
  417.         old_rschar = rschar;
  418.         old_rslen = rslen;
  419.       do_read:
  420.         if (anum > 1)        /* assign to scalar */
  421.         gimme = G_SCALAR;    /* force context to scalar */
  422.         if (gimme == G_ARRAY)
  423.         str = Str_new(57,0);
  424.         ++sp;
  425.         fp = Nullfp;
  426.         if (stab_io(last_in_stab)) {
  427.         fp = stab_io(last_in_stab)->ifp;
  428.         if (!fp) {
  429.             if (stab_io(last_in_stab)->flags & IOF_ARGV) {
  430.             if (stab_io(last_in_stab)->flags & IOF_START) {
  431.                 stab_io(last_in_stab)->flags &= ~IOF_START;
  432.                 stab_io(last_in_stab)->lines = 0;
  433.                 if (alen(stab_array(last_in_stab)) < 0) {
  434.                 tmpstr = str_make("-",1); /* assume stdin */
  435.                 (void)apush(stab_array(last_in_stab), tmpstr);
  436.                 }
  437.             }
  438.             fp = nextargv(last_in_stab);
  439.             if (!fp) { /* Note: fp != stab_io(last_in_stab)->ifp */
  440.                 (void)do_close(last_in_stab,FALSE); /* now it does*/
  441.                 stab_io(last_in_stab)->flags |= IOF_START;
  442.             }
  443.             }
  444.             else if (argtype == A_GLOB) {
  445.             (void) interp(str,stab_val(last_in_stab),sp);
  446.             st = stack->ary_array;
  447.             tmpstr = Str_new(55,0);
  448. #ifdef MSDOS
  449.             str_set(tmpstr, "perlglob ");
  450.             str_scat(tmpstr,str);
  451.             str_cat(tmpstr," |");
  452. #else
  453. #ifdef CSH
  454.             str_nset(tmpstr,cshname,cshlen);
  455.             str_cat(tmpstr," -cf 'set nonomatch; glob ");
  456.             str_scat(tmpstr,str);
  457.             str_cat(tmpstr,"'|");
  458. #else
  459.             str_set(tmpstr, "echo ");
  460.             str_scat(tmpstr,str);
  461.             str_cat(tmpstr,
  462.               "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
  463. #endif /* !CSH */
  464. #endif /* !MSDOS */
  465.             (void)do_open(last_in_stab,tmpstr->str_ptr,
  466.               tmpstr->str_cur);
  467.             fp = stab_io(last_in_stab)->ifp;
  468.             str_free(tmpstr);
  469.             }
  470.         }
  471.         }
  472.         if (!fp && dowarn)
  473.         warn("Read on closed filehandle <%s>",stab_name(last_in_stab));
  474.         when = str->str_len;    /* remember if already alloced */
  475.         if (!when)
  476.         Str_Grow(str,80);    /* try short-buffering it */
  477.       keepgoing:
  478.         if (!fp)
  479.         st[sp] = &str_undef;
  480.         else if (!str_gets(str,fp, optype == O_RCAT ? str->str_cur : 0)) {
  481.         clearerr(fp);
  482.         if (stab_io(last_in_stab)->flags & IOF_ARGV) {
  483.             fp = nextargv(last_in_stab);
  484.             if (fp)
  485.             goto keepgoing;
  486.             (void)do_close(last_in_stab,FALSE);
  487.             stab_io(last_in_stab)->flags |= IOF_START;
  488.         }
  489.         else if (argflags & AF_POST) {
  490.             (void)do_close(last_in_stab,FALSE);
  491.         }
  492.         st[sp] = &str_undef;
  493.         rschar = old_rschar;
  494.         rslen = old_rslen;
  495.         if (gimme == G_ARRAY) {
  496.             --sp;
  497.             str_2mortal(str);
  498.             goto array_return;
  499.         }
  500.         break;
  501.         }
  502.         else {
  503.         stab_io(last_in_stab)->lines++;
  504.         st[sp] = str;
  505. #ifdef TAINT
  506.         str->str_tainted = 1; /* Anything from the outside world...*/
  507. #endif
  508.         if (argflags & AF_POST) {
  509.             if (str->str_cur > 0)
  510.             str->str_cur--;
  511.             if (str->str_ptr[str->str_cur] == rschar)
  512.             str->str_ptr[str->str_cur] = '\0';
  513.             else
  514.             str->str_cur++;
  515.             for (tmps = str->str_ptr; *tmps; tmps++)
  516.             if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
  517.                 index("$&*(){}[]'\";\\|?<>~`",*tmps))
  518.                 break;
  519.             if (*tmps && stat(str->str_ptr,&statbuf) < 0)
  520.             goto keepgoing;        /* unmatched wildcard? */
  521.         }
  522.         if (gimme == G_ARRAY) {
  523.             if (str->str_len - str->str_cur > 20) {
  524.             str->str_len = str->str_cur+1;
  525.             Renew(str->str_ptr, str->str_len, char);
  526.             }
  527.             str_2mortal(str);
  528.             if (++sp > stack->ary_max) {
  529.             astore(stack, sp, Nullstr);
  530.             st = stack->ary_array;
  531.             }
  532.             str = Str_new(58,80);
  533.             goto keepgoing;
  534.         }
  535.         else if (!when && str->str_len - str->str_cur > 80) {
  536.             /* try to reclaim a bit of scalar space on 1st alloc */
  537.             if (str->str_cur < 60)
  538.             str->str_len = 80;
  539.             else
  540.             str->str_len = str->str_cur+40;    /* allow some slop */
  541.             Renew(str->str_ptr, str->str_len, char);
  542.         }
  543.         }
  544.         rschar = old_rschar;
  545.         rslen = old_rslen;
  546. #ifdef DEBUGGING
  547.         tmps = "READ";
  548. #endif
  549.         break;
  550.     }
  551. #ifdef DEBUGGING
  552.     if (debug & 8)
  553.         deb("%d.%s = '%s'\n",anum,tmps,str_peek(st[sp]));
  554. #endif
  555.     if (anum < 8)
  556.         arglast[anum] = sp;
  557.     }
  558.  
  559.  
  560.     st += arglast[0];
  561. #ifdef SMALLSWITCHES
  562.     if (optype < O_DELETE)
  563. #endif
  564.     switch (optype) {
  565.     case O_RCAT:
  566.     STABSET(str);
  567.     break;
  568.     case O_ITEM:
  569.     if (gimme == G_ARRAY)
  570.         goto array_return;
  571.     /* FALL THROUGH */
  572.     case O_SCALAR:
  573.     STR_SSET(str,st[1]);
  574.     STABSET(str);
  575.     break;
  576.     case O_ITEM2:
  577.     if (gimme == G_ARRAY)
  578.         goto array_return;
  579.     --anum;
  580.     STR_SSET(str,st[arglast[anum]-arglast[0]]);
  581.     STABSET(str);
  582.     break;
  583.     case O_ITEM3:
  584.     if (gimme == G_ARRAY)
  585.     goto array_return;
  586.     --anum;
  587.     STR_SSET(str,st[arglast[anum]-arglast[0]]);
  588.     STABSET(str);
  589.     break;
  590.     case O_CONCAT:
  591.     STR_SSET(str,st[1]);
  592.     str_scat(str,st[2]);
  593.     STABSET(str);
  594.     break;
  595.     case O_REPEAT:
  596.     if (gimme == G_ARRAY && arg[1].arg_flags & AF_ARYOK) {
  597.         sp = do_repeatary(arglast);
  598.         goto array_return;
  599.     }
  600.     STR_SSET(str,st[arglast[1] - arglast[0]]);
  601.     anum = (int)str_gnum(st[arglast[2] - arglast[0]]);
  602.     if (anum >= 1) {
  603.         tmpstr = Str_new(50, 0);
  604.         tmps = str_get(str);
  605.         str_nset(tmpstr,tmps,str->str_cur);
  606.         tmps = str_get(tmpstr);    /* force to be string */
  607.         STR_GROW(str, (anum * str->str_cur) + 1);
  608.         repeatcpy(str->str_ptr, tmps, tmpstr->str_cur, anum);
  609.         str->str_cur *= anum;
  610.         str->str_ptr[str->str_cur] = '\0';
  611.         str->str_nok = 0;
  612.         str_free(tmpstr);
  613.     }
  614.     else
  615.         str_sset(str,&str_no);
  616.     STABSET(str);
  617.     break;
  618.     case O_MATCH:
  619.     sp = do_match(str,arg,
  620.       gimme,arglast);
  621.     if (gimme == G_ARRAY)
  622.         goto array_return;
  623.     STABSET(str);
  624.     break;
  625.     case O_NMATCH:
  626.     sp = do_match(str,arg,
  627.       G_SCALAR,arglast);
  628.     str_sset(str, str_true(str) ? &str_no : &str_yes);
  629.     STABSET(str);
  630.     break;
  631.     case O_SUBST:
  632.     sp = do_subst(str,arg,arglast[0]);
  633.     goto array_return;
  634.     case O_NSUBST:
  635.     sp = do_subst(str,arg,arglast[0]);
  636.     str = arg->arg_ptr.arg_str;
  637.     str_set(str, str_true(str) ? No : Yes);
  638.     goto array_return;
  639.     case O_ASSIGN:
  640.     if (arg[1].arg_flags & AF_ARYOK) {
  641.         if (arg->arg_len == 1) {
  642.         arg->arg_type = O_LOCAL;
  643.         goto local;
  644.         }
  645.         else {
  646.         arg->arg_type = O_AASSIGN;
  647.         goto aassign;
  648.         }
  649.     }
  650.     else {
  651.         arg->arg_type = O_SASSIGN;
  652.         goto sassign;
  653.     }
  654.     case O_LOCAL:
  655.       local:
  656.     arglast[2] = arglast[1];    /* push a null array */
  657.     /* FALL THROUGH */
  658.     case O_AASSIGN:
  659.       aassign:
  660.     sp = do_assign(arg,
  661.       gimme,arglast);
  662.     goto array_return;
  663.     case O_SASSIGN:
  664.       sassign:
  665. #ifdef TAINT
  666.     if (tainted && !st[2]->str_tainted)
  667.         tainted = 0;
  668. #endif
  669.     STR_SSET(str, st[2]);
  670.     STABSET(str);
  671.     break;
  672.     case O_CHOP:
  673.     st -= arglast[0];
  674.     str = arg->arg_ptr.arg_str;
  675.     for (sp = arglast[0] + 1; sp <= arglast[1]; sp++)
  676.         do_chop(str,st[sp]);
  677.     st += arglast[0];
  678.     break;
  679.     case O_DEFINED:
  680.     if (arg[1].arg_type & A_DONT) {
  681.         sp = do_defined(str,arg,
  682.           gimme,arglast);
  683.         goto array_return;
  684.     }
  685.     else if (str->str_pok || str->str_nok)
  686.         goto say_yes;
  687.     goto say_no;
  688.     case O_UNDEF:
  689.     if (arg[1].arg_type & A_DONT) {
  690.         sp = do_undef(str,arg,
  691.           gimme,arglast);
  692.         goto array_return;
  693.     }
  694.     else if (str != stab_val(defstab)) {
  695.         if (str->str_len) {
  696.         if (str->str_state == SS_INCR)
  697.             Str_Grow(str,0);
  698.         Safefree(str->str_ptr);
  699.         str->str_ptr = Nullch;
  700.         str->str_len = 0;
  701.         }
  702.         str->str_pok = str->str_nok = 0;
  703.         STABSET(str);
  704.     }
  705.     goto say_undef;
  706.     case O_STUDY:
  707.     sp = do_study(str,arg,
  708.       gimme,arglast);
  709.     goto array_return;
  710.     case O_POW:
  711.     value = str_gnum(st[1]);
  712.     value = pow(value,str_gnum(st[2]));
  713.     goto donumset;
  714.     case O_MULTIPLY:
  715.     value = str_gnum(st[1]);
  716.     value *= str_gnum(st[2]);
  717.     goto donumset;
  718.     case O_DIVIDE:
  719.     if ((value = str_gnum(st[2])) == 0.0)
  720.         fatal("Illegal division by zero");
  721. #ifdef SLOPPYDIVIDE
  722.     /* insure that 20./5. == 4. */
  723.     {
  724.         double x;
  725.         int    k;
  726.         x =  str_gnum(st[1]);
  727.         if ((double)(int)x     == x &&
  728.         (double)(int)value == value &&
  729.         (k = (int)x/(int)value)*(int)value == (int)x) {
  730.         value = k;
  731.         } else {
  732.         value = x/value;
  733.         }
  734.     }
  735. #else
  736.     value = str_gnum(st[1]) / value;
  737. #endif
  738.     goto donumset;
  739.     case O_MODULO:
  740.     tmplong = (long) str_gnum(st[2]);
  741.         if (tmplong == 0L)
  742.             fatal("Illegal modulus zero");
  743.     when = (long)str_gnum(st[1]);
  744. #ifndef lint
  745.     if (when >= 0)
  746.         value = (double)(when % tmplong);
  747.     else
  748.         value = (double)(tmplong - ((-when - 1) % tmplong)) - 1;
  749. #endif
  750.     goto donumset;
  751.     case O_ADD:
  752.     value = str_gnum(st[1]);
  753.     value += str_gnum(st[2]);
  754.     goto donumset;
  755.     case O_SUBTRACT:
  756.     value = str_gnum(st[1]);
  757.     value -= str_gnum(st[2]);
  758.     goto donumset;
  759.     case O_LEFT_SHIFT:
  760.     value = str_gnum(st[1]);
  761.     anum = (int)str_gnum(st[2]);
  762. #ifndef lint
  763.     value = (double)(U_L(value) << anum);
  764. #endif
  765.     goto donumset;
  766.     case O_RIGHT_SHIFT:
  767.     value = str_gnum(st[1]);
  768.     anum = (int)str_gnum(st[2]);
  769. #ifndef lint
  770.     value = (double)(U_L(value) >> anum);
  771. #endif
  772.     goto donumset;
  773.     case O_LT:
  774.     value = str_gnum(st[1]);
  775.     value = (value < str_gnum(st[2])) ? 1.0 : 0.0;
  776.     goto donumset;
  777.     case O_GT:
  778.     value = str_gnum(st[1]);
  779.     value = (value > str_gnum(st[2])) ? 1.0 : 0.0;
  780.     goto donumset;
  781.     case O_LE:
  782.     value = str_gnum(st[1]);
  783.     value = (value <= str_gnum(st[2])) ? 1.0 : 0.0;
  784.     goto donumset;
  785.     case O_GE:
  786.     value = str_gnum(st[1]);
  787.     value = (value >= str_gnum(st[2])) ? 1.0 : 0.0;
  788.     goto donumset;
  789.     case O_EQ:
  790.     if (dowarn) {
  791.         if ((!st[1]->str_nok && !looks_like_number(st[1])) ||
  792.         (!st[2]->str_nok && !looks_like_number(st[2])) )
  793.         warn("Possible use of == on string value");
  794.     }
  795.     value = str_gnum(st[1]);
  796.     value = (value == str_gnum(st[2])) ? 1.0 : 0.0;
  797.     goto donumset;
  798.     case O_NE:
  799.     value = str_gnum(st[1]);
  800.     value = (value != str_gnum(st[2])) ? 1.0 : 0.0;
  801.     goto donumset;
  802.     case O_NCMP:
  803.     value = str_gnum(st[1]);
  804.     value -= str_gnum(st[2]);
  805.     if (value > 0.0)
  806.         value = 1.0;
  807.     else if (value < 0.0)
  808.         value = -1.0;
  809.     goto donumset;
  810.     case O_BIT_AND:
  811.     if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
  812.         value = str_gnum(st[1]);
  813. #ifndef lint
  814.         value = (double)(U_L(value) & U_L(str_gnum(st[2])));
  815. #endif
  816.         goto donumset;
  817.     }
  818.     else
  819.         do_vop(optype,str,st[1],st[2]);
  820.     break;
  821.     case O_XOR:
  822.     if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
  823.         value = str_gnum(st[1]);
  824. #ifndef lint
  825.         value = (double)(U_L(value) ^ U_L(str_gnum(st[2])));
  826. #endif
  827.         goto donumset;
  828.     }
  829.     else
  830.         do_vop(optype,str,st[1],st[2]);
  831.     break;
  832.     case O_BIT_OR:
  833.     if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
  834.         value = str_gnum(st[1]);
  835. #ifndef lint
  836.         value = (double)(U_L(value) | U_L(str_gnum(st[2])));
  837. #endif
  838.         goto donumset;
  839.     }
  840.     else
  841.         do_vop(optype,str,st[1],st[2]);
  842.     break;
  843. /* use register in evaluating str_true() */
  844.     case O_AND:
  845.     if (str_true(st[1])) {
  846.         anum = 2;
  847.         optype = O_ITEM2;
  848.         argflags = arg[anum].arg_flags;
  849.         if (gimme == G_ARRAY)
  850.         argflags |= AF_ARYOK;
  851.         argtype = arg[anum].arg_type & A_MASK;
  852.         argptr = arg[anum].arg_ptr;
  853.         maxarg = anum = 1;
  854.         sp = arglast[0];
  855.         st -= sp;
  856.         goto re_eval;
  857.     }
  858.     else {
  859.         if (assigning) {
  860.         str_sset(str, st[1]);
  861.         STABSET(str);
  862.         }
  863.         else
  864.         str = st[1];
  865.         break;
  866.     }
  867.     case O_OR:
  868.     if (str_true(st[1])) {
  869.         if (assigning) {
  870.         str_sset(str, st[1]);
  871.         STABSET(str);
  872.         }
  873.         else
  874.         str = st[1];
  875.         break;
  876.     }
  877.     else {
  878.         anum = 2;
  879.         optype = O_ITEM2;
  880.         argflags = arg[anum].arg_flags;
  881.         if (gimme == G_ARRAY)
  882.         argflags |= AF_ARYOK;
  883.         argtype = arg[anum].arg_type & A_MASK;
  884.         argptr = arg[anum].arg_ptr;
  885.         maxarg = anum = 1;
  886.         sp = arglast[0];
  887.         st -= sp;
  888.         goto re_eval;
  889.     }
  890.     case O_COND_EXPR:
  891.     anum = (str_true(st[1]) ? 2 : 3);
  892.     optype = (anum == 2 ? O_ITEM2 : O_ITEM3);
  893.     argflags = arg[anum].arg_flags;
  894.     if (gimme == G_ARRAY)
  895.         argflags |= AF_ARYOK;
  896.     argtype = arg[anum].arg_type & A_MASK;
  897.     argptr = arg[anum].arg_ptr;
  898.     maxarg = anum = 1;
  899.     sp = arglast[0];
  900.     st -= sp;
  901.     goto re_eval;
  902.     case O_COMMA:
  903.     if (gimme == G_ARRAY)
  904.         goto array_return;
  905.     str = st[2];
  906.     break;
  907.     case O_NEGATE:
  908.     value = -str_gnum(st[1]);
  909.     goto donumset;
  910.     case O_NOT:
  911. #ifdef NOTNOT
  912.     { char xxx = str_true(st[1]); value = (double) !xxx; }
  913. #else
  914.     value = (double) !str_true(st[1]);
  915. #endif
  916.     goto donumset;
  917.     case O_COMPLEMENT:
  918.     if (!sawvec || st[1]->str_nok) {
  919. #ifndef lint
  920.         value = (double) ~U_L(str_gnum(st[1]));
  921. #endif
  922.         goto donumset;
  923.     }
  924.     else {
  925.         STR_SSET(str,st[1]);
  926.         tmps = str_get(str);
  927.         for (anum = str->str_cur; anum; anum--, tmps++)
  928.         *tmps = ~*tmps;
  929.     }
  930.     break;
  931.     case O_SELECT:
  932.     stab_fullname(str,defoutstab);
  933.     if (maxarg > 0) {
  934.         if ((arg[1].arg_type & A_MASK) == A_WORD)
  935.         defoutstab = arg[1].arg_ptr.arg_stab;
  936.         else
  937.         defoutstab = stabent(str_get(st[1]),TRUE);
  938.         if (!stab_io(defoutstab))
  939.         stab_io(defoutstab) = stio_new();
  940.         curoutstab = defoutstab;
  941.     }
  942.     STABSET(str);
  943.     break;
  944.     case O_WRITE:
  945.     if (maxarg == 0)
  946.         stab = defoutstab;
  947.     else if ((arg[1].arg_type & A_MASK) == A_WORD) {
  948.         if (!(stab = arg[1].arg_ptr.arg_stab))
  949.         stab = defoutstab;
  950.     }
  951.     else
  952.         stab = stabent(str_get(st[1]),TRUE);
  953.     if (!stab_io(stab)) {
  954.         str_set(str, No);
  955.         STABSET(str);
  956.         break;
  957.     }
  958.     curoutstab = stab;
  959.     fp = stab_io(stab)->ofp;
  960.     debarg = arg;
  961.     if (stab_io(stab)->fmt_stab)
  962.         form = stab_form(stab_io(stab)->fmt_stab);
  963.     else
  964.         form = stab_form(stab);
  965.     if (!form || !fp) {
  966.         if (dowarn) {
  967.         if (form)
  968.             warn("No format for filehandle");
  969.         else {
  970.             if (stab_io(stab)->ifp)
  971.             warn("Filehandle only opened for input");
  972.             else
  973.             warn("Write on closed filehandle");
  974.         }
  975.         }
  976.         str_set(str, No);
  977.         STABSET(str);
  978.         break;
  979.     }
  980.     format(&outrec,form,sp);
  981.     do_write(&outrec,stab,sp);
  982.     if (stab_io(stab)->flags & IOF_FLUSH)
  983.         (void)fflush(fp);
  984.     str_set(str, Yes);
  985.     STABSET(str);
  986.     break;
  987.     case O_DBMOPEN:
  988. #ifdef SOME_DBM
  989.     anum = arg[1].arg_type & A_MASK;
  990.     if (anum == A_WORD || anum == A_STAB)
  991.         stab = arg[1].arg_ptr.arg_stab;
  992.     else
  993.         stab = stabent(str_get(st[1]),TRUE);
  994.     if (st[3]->str_nok || st[3]->str_pok)
  995.         anum = (int)str_gnum(st[3]);
  996.     else
  997.         anum = -1;
  998.     value = (double)hdbmopen(stab_hash(stab),str_get(st[2]),anum);
  999.     goto donumset;
  1000. #else
  1001.     fatal("No dbm or ndbm on this machine");
  1002. #endif
  1003.     case O_DBMCLOSE:
  1004. #ifdef SOME_DBM
  1005.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1006.         stab = arg[1].arg_ptr.arg_stab;
  1007.     else
  1008.         stab = stabent(str_get(st[1]),TRUE);
  1009.     hdbmclose(stab_hash(stab));
  1010.     goto say_yes;
  1011. #else
  1012.     fatal("No dbm or ndbm on this machine");
  1013. #endif
  1014.     case O_OPEN:
  1015.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1016.         stab = arg[1].arg_ptr.arg_stab;
  1017.     else
  1018.         stab = stabent(str_get(st[1]),TRUE);
  1019.     tmps = str_get(st[2]);
  1020.     if (do_open(stab,tmps,st[2]->str_cur)) {
  1021.         value = (double)forkprocess;
  1022.         stab_io(stab)->lines = 0;
  1023.         goto donumset;
  1024.     }
  1025.     else if (forkprocess == 0)        /* we are a new child */
  1026.         goto say_zero;
  1027.     else
  1028.         goto say_undef;
  1029.     /* break; */
  1030.     case O_TRANS:
  1031.     value = (double) do_trans(str,arg);
  1032.     str = arg->arg_ptr.arg_str;
  1033.     goto donumset;
  1034.     case O_NTRANS:
  1035.     str_set(arg->arg_ptr.arg_str, do_trans(str,arg) == 0 ? Yes : No);
  1036.     str = arg->arg_ptr.arg_str;
  1037.     break;
  1038.     case O_CLOSE:
  1039.     if (maxarg == 0)
  1040.         stab = defoutstab;
  1041.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  1042.         stab = arg[1].arg_ptr.arg_stab;
  1043.     else
  1044.         stab = stabent(str_get(st[1]),TRUE);
  1045.     str_set(str, do_close(stab,TRUE) ? Yes : No );
  1046.     STABSET(str);
  1047.     break;
  1048.     case O_EACH:
  1049.     sp = do_each(str,stab_hash(arg[1].arg_ptr.arg_stab),
  1050.       gimme,arglast);
  1051.     goto array_return;
  1052.     case O_VALUES:
  1053.     case O_KEYS:
  1054.     sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
  1055.       gimme,arglast);
  1056.     goto array_return;
  1057.     case O_LARRAY:
  1058.     str->str_nok = str->str_pok = 0;
  1059.     str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
  1060.     str->str_state = SS_ARY;
  1061.     break;
  1062.     case O_ARRAY:
  1063.     ary = stab_array(arg[1].arg_ptr.arg_stab);
  1064.     maxarg = ary->ary_fill + 1;
  1065.     if (gimme == G_ARRAY) { /* array wanted */
  1066.         sp = arglast[0];
  1067.         st -= sp;
  1068.         if (maxarg > 0 && sp + maxarg > stack->ary_max) {
  1069.         astore(stack,sp + maxarg, Nullstr);
  1070.         st = stack->ary_array;
  1071.         }
  1072.         st += sp;
  1073.         Copy(ary->ary_array, &st[1], maxarg, STR*);
  1074.         sp += maxarg;
  1075.         goto array_return;
  1076.     }
  1077.     else {
  1078.         value = (double)maxarg;
  1079.         goto donumset;
  1080.     }
  1081.     case O_AELEM:
  1082.     anum = ((int)str_gnum(st[2])) - arybase;
  1083.     str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,FALSE);
  1084.     break;
  1085. #ifdef SMALLSWITCHES
  1086.     }
  1087.     if (optype >= O_DELETE && optype < O_CHOWN)
  1088.     switch (optype) {
  1089. #endif
  1090.     case O_DELETE:
  1091.     tmpstab = arg[1].arg_ptr.arg_stab;
  1092.     tmps = str_get(st[2]);
  1093.     str = hdelete(stab_hash(tmpstab),tmps,st[2]->str_cur);
  1094.     if (tmpstab == envstab)
  1095.         setenv(tmps,Nullch);
  1096.     if (!str)
  1097.         goto say_undef;
  1098.     break;
  1099.     case O_LHASH:
  1100.     str->str_nok = str->str_pok = 0;
  1101.     str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
  1102.     str->str_state = SS_HASH;
  1103.     break;
  1104.     case O_HASH:
  1105.     if (gimme == G_ARRAY) { /* array wanted */
  1106.         sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
  1107.         gimme,arglast);
  1108.         goto array_return;
  1109.     }
  1110.     else {
  1111.         tmpstab = arg[1].arg_ptr.arg_stab;
  1112.         if (!stab_hash(tmpstab)->tbl_fill)
  1113.         goto say_zero;
  1114.         sprintf(buf,"%d/%d",stab_hash(tmpstab)->tbl_fill,
  1115.         stab_hash(tmpstab)->tbl_max+1);
  1116.         str_set(str,buf);
  1117.     }
  1118.     break;
  1119.     case O_HELEM:
  1120.     tmpstab = arg[1].arg_ptr.arg_stab;
  1121.     tmps = str_get(st[2]);
  1122.     str = hfetch(stab_hash(tmpstab),tmps,st[2]->str_cur,FALSE);
  1123.     break;
  1124.     case O_LAELEM:
  1125.     anum = ((int)str_gnum(st[2])) - arybase;
  1126.     str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,TRUE);
  1127.     if (!str || str == &str_undef)
  1128.         fatal("Assignment to non-creatable value, subscript %d",anum);
  1129.     break;
  1130.     case O_LHELEM:
  1131.     tmpstab = arg[1].arg_ptr.arg_stab;
  1132.     tmps = str_get(st[2]);
  1133.     anum = st[2]->str_cur;
  1134.     str = hfetch(stab_hash(tmpstab),tmps,anum,TRUE);
  1135.     if (!str || str == &str_undef)
  1136.         fatal("Assignment to non-creatable value, subscript \"%s\"",tmps);
  1137.     if (tmpstab == envstab)        /* heavy wizardry going on here */
  1138.         str_magic(str, tmpstab, 'E', tmps, anum);    /* str is now magic */
  1139.                     /* he threw the brick up into the air */
  1140.     else if (tmpstab == sigstab)
  1141.         str_magic(str, tmpstab, 'S', tmps, anum);
  1142. #ifdef SOME_DBM
  1143.     else if (stab_hash(tmpstab)->tbl_dbm)
  1144.         str_magic(str, tmpstab, 'D', tmps, anum);
  1145. #endif
  1146.     else if (tmpstab == DBline)
  1147.         str_magic(str, tmpstab, 'L', tmps, anum);
  1148.     break;
  1149.     case O_LSLICE:
  1150.     anum = 2;
  1151.     argtype = FALSE;
  1152.     goto do_slice_already;
  1153.     case O_ASLICE:
  1154.     anum = 1;
  1155.     argtype = FALSE;
  1156.     goto do_slice_already;
  1157.     case O_HSLICE:
  1158.     anum = 0;
  1159.     argtype = FALSE;
  1160.     goto do_slice_already;
  1161.     case O_LASLICE:
  1162.     anum = 1;
  1163.     argtype = TRUE;
  1164.     goto do_slice_already;
  1165.     case O_LHSLICE:
  1166.     anum = 0;
  1167.     argtype = TRUE;
  1168.       do_slice_already:
  1169.     sp = do_slice(arg[1].arg_ptr.arg_stab,str,anum,argtype,
  1170.         gimme,arglast);
  1171.     goto array_return;
  1172.     case O_SPLICE:
  1173.     sp = do_splice(stab_array(arg[1].arg_ptr.arg_stab),gimme,arglast);
  1174.     goto array_return;
  1175.     case O_PUSH:
  1176.     if (arglast[2] - arglast[1] != 1)
  1177.         str = do_push(stab_array(arg[1].arg_ptr.arg_stab),arglast);
  1178.     else {
  1179.         str = Str_new(51,0);        /* must copy the STR */
  1180.         str_sset(str,st[2]);
  1181.         (void)apush(stab_array(arg[1].arg_ptr.arg_stab),str);
  1182.     }
  1183.     break;
  1184.     case O_POP:
  1185.     str = apop(ary = stab_array(arg[1].arg_ptr.arg_stab));
  1186.     goto staticalization;
  1187.     case O_SHIFT:
  1188.     str = ashift(ary = stab_array(arg[1].arg_ptr.arg_stab));
  1189.       staticalization:
  1190.     if (!str)
  1191.         goto say_undef;
  1192.     if (ary->ary_flags & ARF_REAL)
  1193.         (void)str_2mortal(str);
  1194.     break;
  1195.     case O_UNPACK:
  1196.     sp = do_unpack(str,gimme,arglast);
  1197.     goto array_return;
  1198.     case O_SPLIT:
  1199.     value = str_gnum(st[3]);
  1200.     sp = do_split(str, arg[2].arg_ptr.arg_spat, (int)value,
  1201.       gimme,arglast);
  1202.     goto array_return;
  1203.     case O_LENGTH:
  1204.     if (maxarg < 1)
  1205.         value = (double)str_len(stab_val(defstab));
  1206.     else
  1207.         value = (double)str_len(st[1]);
  1208.     goto donumset;
  1209.     case O_SPRINTF:
  1210.     do_sprintf(str, sp-arglast[0], st+1);
  1211.     break;
  1212.     case O_SUBSTR:
  1213.     anum = ((int)str_gnum(st[2])) - arybase;    /* anum=where to start*/
  1214.     tmps = str_get(st[1]);        /* force conversion to string */
  1215.     /*SUPPRESS 560*/
  1216.     if (argtype = (str == st[1]))
  1217.         str = arg->arg_ptr.arg_str;
  1218.     if (anum < 0)
  1219.         anum += st[1]->str_cur + arybase;
  1220.     if (anum < 0 || anum > st[1]->str_cur)
  1221.         str_nset(str,"",0);
  1222.     else {
  1223.         optype = maxarg < 3 ? st[1]->str_cur : (int)str_gnum(st[3]);
  1224.         if (optype < 0)
  1225.         optype = 0;
  1226.         tmps += anum;
  1227.         anum = st[1]->str_cur - anum;    /* anum=how many bytes left*/
  1228.         if (anum > optype)
  1229.         anum = optype;
  1230.         str_nset(str, tmps, anum);
  1231.         if (argtype) {            /* it's an lvalue! */
  1232.         lstr = (struct lstring*)str;
  1233.         str->str_magic = st[1];
  1234.         st[1]->str_rare = 's';
  1235.         lstr->lstr_offset = tmps - str_get(st[1]);
  1236.         lstr->lstr_len = anum;
  1237.         }
  1238.     }
  1239.     break;
  1240.     case O_PACK:
  1241.     /*SUPPRESS 701*/
  1242.     (void)do_pack(str,arglast);
  1243.     break;
  1244.     case O_GREP:
  1245.     sp = do_grep(arg,str,gimme,arglast);
  1246.     goto array_return;
  1247.     case O_JOIN:
  1248.     do_join(str,arglast);
  1249.     break;
  1250.     case O_SLT:
  1251.     tmps = str_get(st[1]);
  1252.     value = (double) (str_cmp(st[1],st[2]) < 0);
  1253.     goto donumset;
  1254.     case O_SGT:
  1255.     tmps = str_get(st[1]);
  1256.     value = (double) (str_cmp(st[1],st[2]) > 0);
  1257.     goto donumset;
  1258.     case O_SLE:
  1259.     tmps = str_get(st[1]);
  1260.     value = (double) (str_cmp(st[1],st[2]) <= 0);
  1261.     goto donumset;
  1262.     case O_SGE:
  1263.     tmps = str_get(st[1]);
  1264.     value = (double) (str_cmp(st[1],st[2]) >= 0);
  1265.     goto donumset;
  1266.     case O_SEQ:
  1267.     tmps = str_get(st[1]);
  1268.     value = (double) str_eq(st[1],st[2]);
  1269.     goto donumset;
  1270.     case O_SNE:
  1271.     tmps = str_get(st[1]);
  1272.     value = (double) !str_eq(st[1],st[2]);
  1273.     goto donumset;
  1274.     case O_SCMP:
  1275.     tmps = str_get(st[1]);
  1276.     value = (double) str_cmp(st[1],st[2]);
  1277.     goto donumset;
  1278.     case O_SUBR:
  1279.     sp = do_subr(arg,gimme,arglast);
  1280.     st = stack->ary_array + arglast[0];        /* maybe realloced */
  1281.     goto array_return;
  1282.     case O_DBSUBR:
  1283.     sp = do_subr(arg,gimme,arglast);
  1284.     st = stack->ary_array + arglast[0];        /* maybe realloced */
  1285.     goto array_return;
  1286.     case O_CALLER:
  1287.     sp = do_caller(arg,maxarg,gimme,arglast);
  1288.     st = stack->ary_array + arglast[0];        /* maybe realloced */
  1289.     goto array_return;
  1290.     case O_SORT:
  1291.     sp = do_sort(str,arg,
  1292.       gimme,arglast);
  1293.     goto array_return;
  1294.     case O_REVERSE:
  1295.     if (gimme == G_ARRAY)
  1296.         sp = do_reverse(arglast);
  1297.     else
  1298.         sp = do_sreverse(str, arglast);
  1299.     goto array_return;
  1300.     case O_WARN:
  1301.     if (arglast[2] - arglast[1] != 1) {
  1302.         do_join(str,arglast);
  1303.         tmps = str_get(str);
  1304.     }
  1305.     else {
  1306.         str = st[2];
  1307.         tmps = str_get(st[2]);
  1308.     }
  1309.     if (!tmps || !*tmps)
  1310.         tmps = "Warning: something's wrong";
  1311.     warn("%s",tmps);
  1312.     goto say_yes;
  1313.     case O_DIE:
  1314.     if (arglast[2] - arglast[1] != 1) {
  1315.         do_join(str,arglast);
  1316.         tmps = str_get(str);
  1317.     }
  1318.     else {
  1319.         str = st[2];
  1320.         tmps = str_get(st[2]);
  1321.     }
  1322.     if (!tmps || !*tmps)
  1323.         tmps = "Died";
  1324.     fatal("%s",tmps);
  1325.     goto say_zero;
  1326.     case O_PRTF:
  1327.     case O_PRINT:
  1328.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1329.         stab = arg[1].arg_ptr.arg_stab;
  1330.     else
  1331.         stab = stabent(str_get(st[1]),TRUE);
  1332.     if (!stab)
  1333.         stab = defoutstab;
  1334.     if (!stab_io(stab)) {
  1335.         if (dowarn)
  1336.         warn("Filehandle never opened");
  1337.         goto say_zero;
  1338.     }
  1339.     if (!(fp = stab_io(stab)->ofp)) {
  1340.         if (dowarn)  {
  1341.         if (stab_io(stab)->ifp)
  1342.             warn("Filehandle opened only for input");
  1343.         else
  1344.             warn("Print on closed filehandle");
  1345.         }
  1346.         goto say_zero;
  1347.     }
  1348.     else {
  1349.         if (optype == O_PRTF || arglast[2] - arglast[1] != 1)
  1350.         value = (double)do_aprint(arg,fp,arglast);
  1351.         else {
  1352.         value = (double)do_print(st[2],fp);
  1353.         if (orslen && optype == O_PRINT)
  1354.             if (fwrite(ors, 1, orslen, fp) == 0)
  1355.             goto say_zero;
  1356.         }
  1357.         if (stab_io(stab)->flags & IOF_FLUSH)
  1358.         if (fflush(fp) == EOF)
  1359.             goto say_zero;
  1360.     }
  1361.     goto donumset;
  1362.     case O_CHDIR:
  1363.     if (maxarg < 1)
  1364.         tmps = Nullch;
  1365.     else
  1366.         tmps = str_get(st[1]);
  1367.     if (!tmps || !*tmps) {
  1368.         tmpstr = hfetch(stab_hash(envstab),"HOME",4,FALSE);
  1369.         tmps = str_get(tmpstr);
  1370.     }
  1371.     if (!tmps || !*tmps) {
  1372.         tmpstr = hfetch(stab_hash(envstab),"LOGDIR",6,FALSE);
  1373.         tmps = str_get(tmpstr);
  1374.     }
  1375. #ifdef TAINT
  1376.     taintproper("Insecure dependency in chdir");
  1377. #endif
  1378.     value = (double)(chdir(tmps) >= 0);
  1379.     goto donumset;
  1380.     case O_EXIT:
  1381.     if (maxarg < 1)
  1382.         anum = 0;
  1383.     else
  1384.         anum = (int)str_gnum(st[1]);
  1385.     exit(anum);
  1386.     goto say_zero;
  1387.     case O_RESET:
  1388.     if (maxarg < 1)
  1389.         tmps = "";
  1390.     else
  1391.         tmps = str_get(st[1]);
  1392.     str_reset(tmps,curcmd->c_stash);
  1393.     value = 1.0;
  1394.     goto donumset;
  1395.     case O_LIST:
  1396.     if (gimme == G_ARRAY)
  1397.         goto array_return;
  1398.     if (maxarg > 0)
  1399.         str = st[sp - arglast[0]];    /* unwanted list, return last item */
  1400.     else
  1401.         str = &str_undef;
  1402.     break;
  1403.     case O_EOF:
  1404.     if (maxarg <= 0)
  1405.         stab = last_in_stab;
  1406.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  1407.         stab = arg[1].arg_ptr.arg_stab;
  1408.     else
  1409.         stab = stabent(str_get(st[1]),TRUE);
  1410.     str_set(str, do_eof(stab) ? Yes : No);
  1411.     STABSET(str);
  1412.     break;
  1413.     case O_GETC:
  1414.     if (maxarg <= 0)
  1415.         stab = stdinstab;
  1416.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  1417.         stab = arg[1].arg_ptr.arg_stab;
  1418.     else
  1419.         stab = stabent(str_get(st[1]),TRUE);
  1420.     if (!stab)
  1421.         stab = argvstab;
  1422.     if (!stab || do_eof(stab)) /* make sure we have fp with something */
  1423.         goto say_undef;
  1424.     else {
  1425. #ifdef TAINT
  1426.         tainted = 1;
  1427. #endif
  1428.         str_set(str," ");
  1429.         *str->str_ptr = getc(stab_io(stab)->ifp); /* should never be EOF */
  1430.     }
  1431.     STABSET(str);
  1432.     break;
  1433.     case O_TELL:
  1434.     if (maxarg <= 0)
  1435.         stab = last_in_stab;
  1436.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  1437.         stab = arg[1].arg_ptr.arg_stab;
  1438.     else
  1439.         stab = stabent(str_get(st[1]),TRUE);
  1440. #ifndef lint
  1441.     value = (double)do_tell(stab);
  1442. #else
  1443.     (void)do_tell(stab);
  1444. #endif
  1445.     goto donumset;
  1446.     case O_RECV:
  1447.     case O_READ:
  1448.     case O_SYSREAD:
  1449.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1450.         stab = arg[1].arg_ptr.arg_stab;
  1451.     else
  1452.         stab = stabent(str_get(st[1]),TRUE);
  1453.     tmps = str_get(st[2]);
  1454.     anum = (int)str_gnum(st[3]);
  1455.     errno = 0;
  1456.     maxarg = sp - arglast[0];
  1457.     if (maxarg > 4)
  1458.         warn("Too many args on read");
  1459.     if (maxarg == 4)
  1460.         maxarg = (int)str_gnum(st[4]);
  1461.     else
  1462.         maxarg = 0;
  1463.     if (!stab_io(stab) || !stab_io(stab)->ifp)
  1464.         goto say_undef;
  1465. #ifdef HAS_SOCKET
  1466.     if (optype == O_RECV) {
  1467.         argtype = sizeof buf;
  1468.         STR_GROW(st[2], anum+1), (tmps = str_get(st[2]));  /* sneaky */
  1469.         anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, maxarg,
  1470.         buf, &argtype);
  1471.         if (anum >= 0) {
  1472.         st[2]->str_cur = anum;
  1473.         st[2]->str_ptr[anum] = '\0';
  1474.         str_nset(str,buf,argtype);
  1475.         }
  1476.         else
  1477.         str_sset(str,&str_undef);
  1478.         break;
  1479.     }
  1480. #else
  1481.     if (optype == O_RECV)
  1482.         goto badsock;
  1483. #endif
  1484.     STR_GROW(st[2], anum+maxarg+1), (tmps = str_get(st[2]));  /* sneaky */
  1485.     if (optype == O_SYSREAD) {
  1486.         anum = read(fileno(stab_io(stab)->ifp), tmps+maxarg, anum);
  1487.     }
  1488.     else
  1489. #ifdef HAS_SOCKET
  1490.     if (stab_io(stab)->type == 's') {
  1491.         argtype = sizeof buf;
  1492.         anum = recvfrom(fileno(stab_io(stab)->ifp), tmps+maxarg, anum, 0,
  1493.         buf, &argtype);
  1494.     }
  1495.     else
  1496. #endif
  1497.         anum = fread(tmps+maxarg, 1, anum, stab_io(stab)->ifp);
  1498.     if (anum < 0)
  1499.         goto say_undef;
  1500.     st[2]->str_cur = anum+maxarg;
  1501.     st[2]->str_ptr[anum+maxarg] = '\0';
  1502.     value = (double)anum;
  1503.     goto donumset;
  1504.     case O_SYSWRITE:
  1505.     case O_SEND:
  1506.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1507.         stab = arg[1].arg_ptr.arg_stab;
  1508.     else
  1509.         stab = stabent(str_get(st[1]),TRUE);
  1510.     tmps = str_get(st[2]);
  1511.     anum = (int)str_gnum(st[3]);
  1512.     errno = 0;
  1513.     stio = stab_io(stab);
  1514.     maxarg = sp - arglast[0];
  1515.     if (!stio || !stio->ifp) {
  1516.         anum = -1;
  1517.         if (dowarn) {
  1518.         if (optype == O_SYSWRITE)
  1519.             warn("Syswrite on closed filehandle");
  1520.         else
  1521.             warn("Send on closed socket");
  1522.         }
  1523.     }
  1524.     else if (optype == O_SYSWRITE) {
  1525.         if (maxarg > 4)
  1526.         warn("Too many args on syswrite");
  1527.         if (maxarg == 4)
  1528.         optype = (int)str_gnum(st[4]);
  1529.         else
  1530.         optype = 0;
  1531.         anum = write(fileno(stab_io(stab)->ifp), tmps+optype, anum);
  1532.     }
  1533. #ifdef HAS_SOCKET
  1534.     else if (maxarg >= 4) {
  1535.         if (maxarg > 4)
  1536.         warn("Too many args on send");
  1537.         tmps2 = str_get(st[4]);
  1538.         anum = sendto(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur,
  1539.           anum, tmps2, st[4]->str_cur);
  1540.     }
  1541.     else
  1542.         anum = send(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, anum);
  1543. #else
  1544.     else
  1545.         goto badsock;
  1546. #endif
  1547.     if (anum < 0)
  1548.         goto say_undef;
  1549.     value = (double)anum;
  1550.     goto donumset;
  1551.     case O_SEEK:
  1552.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1553.         stab = arg[1].arg_ptr.arg_stab;
  1554.     else
  1555.         stab = stabent(str_get(st[1]),TRUE);
  1556.     value = str_gnum(st[2]);
  1557.     str_set(str, do_seek(stab,
  1558.       (long)value, (int)str_gnum(st[3]) ) ? Yes : No);
  1559.     STABSET(str);
  1560.     break;
  1561.     case O_RETURN:
  1562.     tmps = "_SUB_";        /* just fake up a "last _SUB_" */
  1563.     optype = O_LAST;
  1564.     if (curcsv && curcsv->wantarray == G_ARRAY) {
  1565.         lastretstr = Nullstr;
  1566.         lastspbase = arglast[1];
  1567.         lastsize = arglast[2] - arglast[1];
  1568.     }
  1569.     else
  1570.         lastretstr = str_mortal(st[arglast[2] - arglast[0]]);
  1571.     goto dopop;
  1572.     case O_REDO:
  1573.     case O_NEXT:
  1574.     case O_LAST:
  1575.     tmps = Nullch;
  1576.     if (maxarg > 0) {
  1577.         tmps = str_get(arg[1].arg_ptr.arg_str);
  1578.       dopop:
  1579.         while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
  1580.           strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
  1581. #ifdef DEBUGGING
  1582.         if (debug & 4) {
  1583.             deb("(Skipping label #%d %s)\n",loop_ptr,
  1584.             loop_stack[loop_ptr].loop_label);
  1585.         }
  1586. #endif
  1587.         loop_ptr--;
  1588.         }
  1589. #ifdef DEBUGGING
  1590.         if (debug & 4) {
  1591.         deb("(Found label #%d %s)\n",loop_ptr,
  1592.             loop_stack[loop_ptr].loop_label);
  1593.         }
  1594. #endif
  1595.     }
  1596.     if (loop_ptr < 0) {
  1597.         if (tmps && strEQ(tmps, "_SUB_"))
  1598.         fatal("Can't return outside a subroutine");
  1599.         fatal("Bad label: %s", maxarg > 0 ? tmps : "<null>");
  1600.     }
  1601.     if (!lastretstr && optype == O_LAST && lastsize) {
  1602.         st -= arglast[0];
  1603.         st += lastspbase + 1;
  1604.         optype = loop_stack[loop_ptr].loop_sp - lastspbase; /* negative */
  1605.         if (optype) {
  1606.         for (anum = lastsize; anum > 0; anum--,st++)
  1607.             st[optype] = str_mortal(st[0]);
  1608.         }
  1609.         longjmp(loop_stack[loop_ptr].loop_env, O_LAST);
  1610.     }
  1611.     longjmp(loop_stack[loop_ptr].loop_env, optype);
  1612.     case O_DUMP:
  1613.     case O_GOTO:/* shudder */
  1614.     goto_targ = str_get(arg[1].arg_ptr.arg_str);
  1615.     if (!*goto_targ)
  1616.         goto_targ = Nullch;        /* just restart from top */
  1617.     if (optype == O_DUMP) {
  1618.         do_undump = 1;
  1619.         my_unexec();
  1620.     }
  1621.     longjmp(top_env, 1);
  1622.     case O_INDEX:
  1623.     tmps = str_get(st[1]);
  1624.     if (maxarg < 3)
  1625.         anum = 0;
  1626.     else {
  1627.         anum = (int) str_gnum(st[3]) - arybase;
  1628.         if (anum < 0)
  1629.         anum = 0;
  1630.         else if (anum > st[1]->str_cur)
  1631.         anum = st[1]->str_cur;
  1632.     }
  1633. #ifndef lint
  1634.     if (!(tmps2 = fbminstr((unsigned char*)tmps + anum,
  1635.       (unsigned char*)tmps + st[1]->str_cur, st[2])))
  1636. #else
  1637.     if (tmps2 = fbminstr(Null(unsigned char*),Null(unsigned char*),Nullstr))
  1638. #endif
  1639.         value = (double)(-1 + arybase);
  1640.     else
  1641.         value = (double)(tmps2 - tmps + arybase);
  1642.     goto donumset;
  1643.     case O_RINDEX:
  1644.     tmps = str_get(st[1]);
  1645.     tmps2 = str_get(st[2]);
  1646.     if (maxarg < 3)
  1647.         anum = st[1]->str_cur;
  1648.     else {
  1649.         anum = (int) str_gnum(st[3]) - arybase + st[2]->str_cur;
  1650.         if (anum < 0)
  1651.         anum = 0;
  1652.         else if (anum > st[1]->str_cur)
  1653.         anum = st[1]->str_cur;
  1654.     }
  1655. #ifndef lint
  1656.     if (!(tmps2 = rninstr(tmps,  tmps  + anum,
  1657.                   tmps2, tmps2 + st[2]->str_cur)))
  1658. #else
  1659.     if (tmps2 = rninstr(Nullch,Nullch,Nullch,Nullch))
  1660. #endif
  1661.         value = (double)(-1 + arybase);
  1662.     else
  1663.         value = (double)(tmps2 - tmps + arybase);
  1664.     goto donumset;
  1665.     case O_TIME:
  1666. #ifndef lint
  1667.     value = (double) time(Null(long*));
  1668. #endif
  1669.     goto donumset;
  1670.     case O_TMS:
  1671.     sp = do_tms(str,gimme,arglast);
  1672.     goto array_return;
  1673.     case O_LOCALTIME:
  1674.     if (maxarg < 1)
  1675.         (void)time(&when);
  1676.     else
  1677.         when = (long)str_gnum(st[1]);
  1678.     sp = do_time(str,localtime(&when),
  1679.       gimme,arglast);
  1680.     goto array_return;
  1681.     case O_GMTIME:
  1682.     if (maxarg < 1)
  1683.         (void)time(&when);
  1684.     else
  1685.         when = (long)str_gnum(st[1]);
  1686.     sp = do_time(str,gmtime(&when),
  1687.       gimme,arglast);
  1688.     goto array_return;
  1689.     case O_TRUNCATE:
  1690.     sp = do_truncate(str,arg,
  1691.       gimme,arglast);
  1692.     goto array_return;
  1693.     case O_LSTAT:
  1694.     case O_STAT:
  1695.     sp = do_stat(str,arg,
  1696.       gimme,arglast);
  1697.     goto array_return;
  1698.     case O_CRYPT:
  1699. #ifdef HAS_CRYPT
  1700.     tmps = str_get(st[1]);
  1701. #ifdef FCRYPT
  1702.     str_set(str,fcrypt(tmps,str_get(st[2])));
  1703. #else
  1704.     str_set(str,crypt(tmps,str_get(st[2])));
  1705. #endif
  1706. #else
  1707.     fatal(
  1708.       "The crypt() function is unimplemented due to excessive paranoia.");
  1709. #endif
  1710.     break;
  1711.     case O_ATAN2:
  1712.     value = str_gnum(st[1]);
  1713.     value = atan2(value,str_gnum(st[2]));
  1714.     goto donumset;
  1715.     case O_SIN:
  1716.     if (maxarg < 1)
  1717.         value = str_gnum(stab_val(defstab));
  1718.     else
  1719.         value = str_gnum(st[1]);
  1720.     value = sin(value);
  1721.     goto donumset;
  1722.     case O_COS:
  1723.     if (maxarg < 1)
  1724.         value = str_gnum(stab_val(defstab));
  1725.     else
  1726.         value = str_gnum(st[1]);
  1727.     value = cos(value);
  1728.     goto donumset;
  1729.     case O_RAND:
  1730.     if (maxarg < 1)
  1731.         value = 1.0;
  1732.     else
  1733.         value = str_gnum(st[1]);
  1734.     if (value == 0.0)
  1735.         value = 1.0;
  1736. #if RANDBITS == 31
  1737.     value = rand() * value / 2147483648.0;
  1738. #else
  1739. #if RANDBITS == 16
  1740.     value = rand() * value / 65536.0;
  1741. #else
  1742. #if RANDBITS == 15
  1743.     value = rand() * value / 32768.0;
  1744. #else
  1745.     value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
  1746. #endif
  1747. #endif
  1748. #endif
  1749.     goto donumset;
  1750.     case O_SRAND:
  1751.     if (maxarg < 1) {
  1752.         (void)time(&when);
  1753.         anum = when;
  1754.     }
  1755.     else
  1756.         anum = (int)str_gnum(st[1]);
  1757.     (void)srand(anum);
  1758.     goto say_yes;
  1759.     case O_EXP:
  1760.     if (maxarg < 1)
  1761.         value = str_gnum(stab_val(defstab));
  1762.     else
  1763.         value = str_gnum(st[1]);
  1764.     value = exp(value);
  1765.     goto donumset;
  1766.     case O_LOG:
  1767.     if (maxarg < 1)
  1768.         value = str_gnum(stab_val(defstab));
  1769.     else
  1770.         value = str_gnum(st[1]);
  1771.     if (value <= 0.0)
  1772.         fatal("Can't take log of %g\n", value);
  1773.     value = log(value);
  1774.     goto donumset;
  1775.     case O_SQRT:
  1776.     if (maxarg < 1)
  1777.         value = str_gnum(stab_val(defstab));
  1778.     else
  1779.         value = str_gnum(st[1]);
  1780.     if (value < 0.0)
  1781.         fatal("Can't take sqrt of %g\n", value);
  1782.     value = sqrt(value);
  1783.     goto donumset;
  1784.     case O_INT:
  1785.     if (maxarg < 1)
  1786.         value = str_gnum(stab_val(defstab));
  1787.     else
  1788.         value = str_gnum(st[1]);
  1789.     if (value >= 0.0)
  1790.         (void)modf(value,&value);
  1791.     else {
  1792.         (void)modf(-value,&value);
  1793.         value = -value;
  1794.     }
  1795.     goto donumset;
  1796.     case O_ORD:
  1797.     if (maxarg < 1)
  1798.         tmps = str_get(stab_val(defstab));
  1799.     else
  1800.         tmps = str_get(st[1]);
  1801. #ifndef I286
  1802.     value = (double) (*tmps & 255);
  1803. #else
  1804.     anum = (int) *tmps;
  1805.     value = (double) (anum & 255);
  1806. #endif
  1807.     goto donumset;
  1808.     case O_ALARM:
  1809. #ifdef HAS_ALARM
  1810.     if (maxarg < 1)
  1811.         tmps = str_get(stab_val(defstab));
  1812.     else
  1813.         tmps = str_get(st[1]);
  1814.     if (!tmps)
  1815.         tmps = "0";
  1816.     anum = alarm((unsigned int)atoi(tmps));
  1817.     if (anum < 0)
  1818.         goto say_undef;
  1819.     value = (double)anum;
  1820.     goto donumset;
  1821. #else
  1822.     fatal("Unsupported function alarm");
  1823.     break;
  1824. #endif
  1825.     case O_SLEEP:
  1826.     if (maxarg < 1)
  1827.         tmps = Nullch;
  1828.     else
  1829.         tmps = str_get(st[1]);
  1830.     (void)time(&when);
  1831.     if (!tmps || !*tmps)
  1832.         sleep((32767<<16)+32767);
  1833.     else
  1834.         sleep((unsigned int)atoi(tmps));
  1835. #ifndef lint
  1836.     value = (double)when;
  1837.     (void)time(&when);
  1838.     value = ((double)when) - value;
  1839. #endif
  1840.     goto donumset;
  1841.     case O_RANGE:
  1842.     sp = do_range(gimme,arglast);
  1843.     goto array_return;
  1844.     case O_F_OR_R:
  1845.     if (gimme == G_ARRAY) {        /* it's a range */
  1846.         /* can we optimize to constant array? */
  1847.         if ((arg[1].arg_type & A_MASK) == A_SINGLE &&
  1848.           (arg[2].arg_type & A_MASK) == A_SINGLE) {
  1849.         st[2] = arg[2].arg_ptr.arg_str;
  1850.         sp = do_range(gimme,arglast);
  1851.         st = stack->ary_array;
  1852.         maxarg = sp - arglast[0];
  1853.         str_free(arg[1].arg_ptr.arg_str);
  1854.         arg[1].arg_ptr.arg_str = Nullstr;
  1855.         str_free(arg[2].arg_ptr.arg_str);
  1856.         arg[2].arg_ptr.arg_str = Nullstr;
  1857.         arg->arg_type = O_ARRAY;
  1858.         arg[1].arg_type = A_STAB|A_DONT;
  1859.         arg->arg_len = 1;
  1860.         stab = arg[1].arg_ptr.arg_stab = aadd(genstab());
  1861.         ary = stab_array(stab);
  1862.         afill(ary,maxarg - 1);
  1863.         anum = maxarg;
  1864.         st += arglast[0]+1;
  1865.         while (maxarg-- > 0)
  1866.             ary->ary_array[maxarg] = str_smake(st[maxarg]);
  1867.         st -= arglast[0]+1;
  1868.         goto array_return;
  1869.         }
  1870.         arg->arg_type = optype = O_RANGE;
  1871.         maxarg = arg->arg_len = 2;
  1872.         anum = 2;
  1873.         arg[anum].arg_flags &= ~AF_ARYOK;
  1874.         argflags = arg[anum].arg_flags;
  1875.         argtype = arg[anum].arg_type & A_MASK;
  1876.         arg[anum].arg_type = argtype;
  1877.         argptr = arg[anum].arg_ptr;
  1878.         sp = arglast[0];
  1879.         st -= sp;
  1880.         sp++;
  1881.         goto re_eval;
  1882.     }
  1883.     arg->arg_type = O_FLIP;
  1884.     /* FALL THROUGH */
  1885.     case O_FLIP:
  1886.     if ((arg[1].arg_type & A_MASK) == A_SINGLE ?
  1887.       last_in_stab && (int)str_gnum(st[1]) == stab_io(last_in_stab)->lines
  1888.       :
  1889.       str_true(st[1]) ) {
  1890.         str_numset(str,0.0);
  1891.         anum = 2;
  1892.         arg->arg_type = optype = O_FLOP;
  1893.         arg[2].arg_type &= ~A_DONT;
  1894.         arg[1].arg_type |= A_DONT;
  1895.         argflags = arg[2].arg_flags;
  1896.         argtype = arg[2].arg_type & A_MASK;
  1897.         argptr = arg[2].arg_ptr;
  1898.         sp = arglast[0];
  1899.         st -= sp++;
  1900.         goto re_eval;
  1901.     }
  1902.     str_set(str,"");
  1903.     break;
  1904.     case O_FLOP:
  1905.     str_inc(str);
  1906.     if ((arg[2].arg_type & A_MASK) == A_SINGLE ?
  1907.       last_in_stab && (int)str_gnum(st[2]) == stab_io(last_in_stab)->lines
  1908.       :
  1909.       str_true(st[2]) ) {
  1910.         arg->arg_type = O_FLIP;
  1911.         arg[1].arg_type &= ~A_DONT;
  1912.         arg[2].arg_type |= A_DONT;
  1913.         str_cat(str,"E0");
  1914.     }
  1915.     break;
  1916.     case O_FORK:
  1917. #ifdef HAS_FORK
  1918.     anum = fork();
  1919.     if (anum < 0)
  1920.         goto say_undef;
  1921.     if (!anum) {
  1922.         /*SUPPRESS 560*/
  1923.         if (tmpstab = stabent("$",allstabs))
  1924.         str_numset(STAB_STR(tmpstab),(double)getpid());
  1925.         hclear(pidstatus, FALSE);    /* no kids, so don't wait for 'em */
  1926.     }
  1927.     value = (double)anum;
  1928.     goto donumset;
  1929. #else
  1930.     fatal("Unsupported function fork");
  1931.     break;
  1932. #endif
  1933.     case O_WAIT:
  1934. #ifdef HAS_WAIT
  1935. #ifndef lint
  1936.     anum = wait(&argflags);
  1937.     if (anum > 0)
  1938.         pidgone(anum,argflags);
  1939.     value = (double)anum;
  1940. #endif
  1941.     statusvalue = (unsigned short)argflags;
  1942.     goto donumset;
  1943. #else
  1944.     fatal("Unsupported function wait");
  1945.     break;
  1946. #endif
  1947.     case O_WAITPID:
  1948. #ifdef HAS_WAIT
  1949. #ifndef lint
  1950.     anum = (int)str_gnum(st[1]);
  1951.     optype = (int)str_gnum(st[2]);
  1952.     anum = wait4pid(anum, &argflags,optype);
  1953.     value = (double)anum;
  1954. #endif
  1955.     statusvalue = (unsigned short)argflags;
  1956.     goto donumset;
  1957. #else
  1958.     fatal("Unsupported function wait");
  1959.     break;
  1960. #endif
  1961.     case O_SYSTEM:
  1962. #ifdef HAS_FORK
  1963. #ifdef TAINT
  1964.     if (arglast[2] - arglast[1] == 1) {
  1965.         taintenv();
  1966.         tainted |= st[2]->str_tainted;
  1967.         taintproper("Insecure dependency in system");
  1968.     }
  1969. #endif
  1970.     while ((anum = vfork()) == -1) {
  1971.         if (errno != EAGAIN) {
  1972.         value = -1.0;
  1973.         goto donumset;
  1974.         }
  1975.         sleep(5);
  1976.     }
  1977.     if (anum > 0) {
  1978. #ifndef lint
  1979.         ihand = signal(SIGINT, SIG_IGN);
  1980.         qhand = signal(SIGQUIT, SIG_IGN);
  1981.         argtype = wait4pid(anum, &argflags, 0);
  1982. #else
  1983.         ihand = qhand = 0;
  1984. #endif
  1985.         (void)signal(SIGINT, ihand);
  1986.         (void)signal(SIGQUIT, qhand);
  1987.         statusvalue = (unsigned short)argflags;
  1988.         if (argtype < 0)
  1989.         value = -1.0;
  1990.         else {
  1991.         value = (double)((unsigned int)argflags & 0xffff);
  1992.         }
  1993.         do_execfree();    /* free any memory child malloced on vfork */
  1994.         goto donumset;
  1995.     }
  1996.     if ((arg[1].arg_type & A_MASK) == A_STAB)
  1997.         value = (double)do_aexec(st[1],arglast);
  1998.     else if (arglast[2] - arglast[1] != 1)
  1999.         value = (double)do_aexec(Nullstr,arglast);
  2000.     else {
  2001.         value = (double)do_exec(str_get(str_mortal(st[2])));
  2002.     }
  2003.     _exit(-1);
  2004. #else /* ! FORK */
  2005.     if ((arg[1].arg_type & A_MASK) == A_STAB)
  2006.         value = (double)do_aspawn(st[1],arglast);
  2007.     else if (arglast[2] - arglast[1] != 1)
  2008.         value = (double)do_aspawn(Nullstr,arglast);
  2009.     else {
  2010.         value = (double)do_spawn(str_get(str_mortal(st[2])));
  2011.     }
  2012.     goto donumset;
  2013. #endif /* FORK */
  2014.     case O_EXEC_OP:
  2015.     if ((arg[1].arg_type & A_MASK) == A_STAB)
  2016.         value = (double)do_aexec(st[1],arglast);
  2017.     else if (arglast[2] - arglast[1] != 1)
  2018.         value = (double)do_aexec(Nullstr,arglast);
  2019.     else {
  2020. #ifdef TAINT
  2021.         taintenv();
  2022.         tainted |= st[2]->str_tainted;
  2023.         taintproper("Insecure dependency in exec");
  2024. #endif
  2025.         value = (double)do_exec(str_get(str_mortal(st[2])));
  2026.     }
  2027.     goto donumset;
  2028.     case O_HEX:
  2029.     if (maxarg < 1)
  2030.         tmps = str_get(stab_val(defstab));
  2031.     else
  2032.         tmps = str_get(st[1]);
  2033.     value = (double)scanhex(tmps, 99, &argtype);
  2034.     goto donumset;
  2035.  
  2036.  
  2037.     case O_OCT:
  2038.     if (maxarg < 1)
  2039.         tmps = str_get(stab_val(defstab));
  2040.     else
  2041.         tmps = str_get(st[1]);
  2042.     while (*tmps && (isSPACE(*tmps) || *tmps == '0'))
  2043.         tmps++;
  2044.     if (*tmps == 'x')
  2045.         value = (double)scanhex(++tmps, 99, &argtype);
  2046.     else
  2047.         value = (double)scanoct(tmps, 99, &argtype);
  2048.     goto donumset;
  2049.  
  2050.  
  2051. /* These common exits are hidden here in the middle of the switches for the
  2052.    benefit of those machines with limited branch addressing.  Sigh.  */
  2053.  
  2054.  
  2055. array_return:
  2056. #ifdef DEBUGGING
  2057.     if (debug) {
  2058.     dlevel--;
  2059.     if (debug & 8) {
  2060.         anum = sp - arglast[0];
  2061.         switch (anum) {
  2062.         case 0:
  2063.         deb("%s RETURNS ()\n",opname[optype]);
  2064.         break;
  2065.         case 1:
  2066.         deb("%s RETURNS (\"%s\")\n",opname[optype],
  2067.             st[1] ? str_get(st[1]) : "");
  2068.         break;
  2069.         default:
  2070.         tmps = st[1] ? str_get(st[1]) : "";
  2071.         deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\")\n",opname[optype],
  2072.           anum,tmps,anum==2?"":"...,",
  2073.             st[anum] ? str_get(st[anum]) : "");
  2074.         break;
  2075.         }
  2076.     }
  2077.     }
  2078. #endif
  2079.     return sp;
  2080.  
  2081.  
  2082. say_yes:
  2083.     str = &str_yes;
  2084.     goto normal_return;
  2085.  
  2086.  
  2087. say_no:
  2088.     str = &str_no;
  2089.     goto normal_return;
  2090.  
  2091.  
  2092. say_undef:
  2093.     str = &str_undef;
  2094.     goto normal_return;
  2095.  
  2096.  
  2097. say_zero:
  2098.     value = 0.0;
  2099.     /* FALL THROUGH */
  2100.  
  2101.  
  2102. donumset:
  2103.     str_numset(str,value);
  2104.     STABSET(str);
  2105.     st[1] = str;
  2106. #ifdef DEBUGGING
  2107.     if (debug) {
  2108.     dlevel--;
  2109.     if (debug & 8)
  2110.         deb("%s RETURNS \"%f\"\n",opname[optype],value);
  2111.     }
  2112. #endif
  2113.     return arglast[0] + 1;
  2114. #ifdef SMALLSWITCHES
  2115.     }
  2116.     else
  2117.     switch (optype) {
  2118. #endif
  2119.     case O_CHOWN:
  2120. #ifdef HAS_CHOWN
  2121.     value = (double)apply(optype,arglast);
  2122.     goto donumset;
  2123. #else
  2124.     fatal("Unsupported function chown");
  2125.     break;
  2126. #endif
  2127.     case O_KILL:
  2128. #ifdef HAS_KILL
  2129.     value = (double)apply(optype,arglast);
  2130.     goto donumset;
  2131. #else
  2132.     fatal("Unsupported function kill");
  2133.     break;
  2134. #endif
  2135.     case O_UNLINK:
  2136.     case O_CHMOD:
  2137.     case O_UTIME:
  2138.     value = (double)apply(optype,arglast);
  2139.     goto donumset;
  2140.     case O_UMASK:
  2141. #ifdef HAS_UMASK
  2142.     if (maxarg < 1) {
  2143.         anum = umask(0);
  2144.         (void)umask(anum);
  2145.     }
  2146.     else
  2147.         anum = umask((int)str_gnum(st[1]));
  2148.     value = (double)anum;
  2149. #ifdef TAINT
  2150.     taintproper("Insecure dependency in umask");
  2151. #endif
  2152.     goto donumset;
  2153. #else
  2154.     fatal("Unsupported function umask");
  2155.     break;
  2156. #endif
  2157. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  2158.     case O_MSGGET:
  2159.     case O_SHMGET:
  2160.     case O_SEMGET:
  2161.     if ((anum = do_ipcget(optype, arglast)) == -1)
  2162.         goto say_undef;
  2163.     value = (double)anum;
  2164.     goto donumset;
  2165.     case O_MSGCTL:
  2166.     case O_SHMCTL:
  2167.     case O_SEMCTL:
  2168.     anum = do_ipcctl(optype, arglast);
  2169.     if (anum == -1)
  2170.         goto say_undef;
  2171.     if (anum != 0) {
  2172.         value = (double)anum;
  2173.         goto donumset;
  2174.     }
  2175.     str_set(str,"0 but true");
  2176.     STABSET(str);
  2177.     break;
  2178.     case O_MSGSND:
  2179.     value = (double)(do_msgsnd(arglast) >= 0);
  2180.     goto donumset;
  2181.     case O_MSGRCV:
  2182.     value = (double)(do_msgrcv(arglast) >= 0);
  2183.     goto donumset;
  2184.     case O_SEMOP:
  2185.     value = (double)(do_semop(arglast) >= 0);
  2186.     goto donumset;
  2187.     case O_SHMREAD:
  2188.     case O_SHMWRITE:
  2189.     value = (double)(do_shmio(optype, arglast) >= 0);
  2190.     goto donumset;
  2191. #else /* not SYSVIPC */
  2192.     case O_MSGGET:
  2193.     case O_MSGCTL:
  2194.     case O_MSGSND:
  2195.     case O_MSGRCV:
  2196.     case O_SEMGET:
  2197.     case O_SEMCTL:
  2198.     case O_SEMOP:
  2199.     case O_SHMGET:
  2200.     case O_SHMCTL:
  2201.     case O_SHMREAD:
  2202.     case O_SHMWRITE:
  2203.     fatal("System V IPC is not implemented on this machine");
  2204. #endif /* not SYSVIPC */
  2205.     case O_RENAME:
  2206.     tmps = str_get(st[1]);
  2207.     tmps2 = str_get(st[2]);
  2208. #ifdef TAINT
  2209.     taintproper("Insecure dependency in rename");
  2210. #endif
  2211. #ifdef HAS_RENAME
  2212.     value = (double)(rename(tmps,tmps2) >= 0);
  2213. #else
  2214.     if (same_dirent(tmps2, tmps))    /* can always rename to same name */
  2215.         anum = 1;
  2216.     else {
  2217.         if (euid || stat(tmps2,&statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
  2218.         (void)UNLINK(tmps2);
  2219.         if (!(anum = link(tmps,tmps2)))
  2220.         anum = UNLINK(tmps);
  2221.     }
  2222.     value = (double)(anum >= 0);
  2223. #endif
  2224.     goto donumset;
  2225.     case O_LINK:
  2226. #ifdef HAS_LINK
  2227.     tmps = str_get(st[1]);
  2228.     tmps2 = str_get(st[2]);
  2229. #ifdef TAINT
  2230.     taintproper("Insecure dependency in link");
  2231. #endif
  2232.     value = (double)(link(tmps,tmps2) >= 0);
  2233.     goto donumset;
  2234. #else
  2235.     fatal("Unsupported function link");
  2236.     break;
  2237. #endif
  2238.     case O_MKDIR:
  2239.     tmps = str_get(st[1]);
  2240.     anum = (int)str_gnum(st[2]);
  2241. #ifdef TAINT
  2242.     taintproper("Insecure dependency in mkdir");
  2243. #endif
  2244. #ifdef HAS_MKDIR
  2245.     value = (double)(mkdir(tmps,anum) >= 0);
  2246.     goto donumset;
  2247. #else
  2248.     (void)strcpy(buf,"mkdir ");
  2249. #endif
  2250. #if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
  2251.       one_liner:
  2252.     for (tmps2 = buf+6; *tmps; ) {
  2253.         *tmps2++ = '\\';
  2254.         *tmps2++ = *tmps++;
  2255.     }
  2256.     (void)strcpy(tmps2," 2>&1");
  2257.     rsfp = mypopen(buf,"r");
  2258.     if (rsfp) {
  2259.         *buf = '\0';
  2260.         tmps2 = fgets(buf,sizeof buf,rsfp);
  2261.         (void)mypclose(rsfp);
  2262.         if (tmps2 != Nullch) {
  2263.         for (errno = 1; errno < sys_nerr; errno++) {
  2264.             if (instr(buf,sys_errlist[errno]))    /* you don't see this */
  2265.             goto say_zero;
  2266.         }
  2267.         errno = 0;
  2268. #ifndef EACCES
  2269. #define EACCES EPERM
  2270. #endif
  2271.         if (instr(buf,"cannot make"))
  2272.             errno = EEXIST;
  2273.         else if (instr(buf,"existing file"))
  2274.             errno = EEXIST;
  2275.         else if (instr(buf,"ile exists"))
  2276.             errno = EEXIST;
  2277.         else if (instr(buf,"non-exist"))
  2278.             errno = ENOENT;
  2279.         else if (instr(buf,"does not exist"))
  2280.             errno = ENOENT;
  2281.         else if (instr(buf,"not empty"))
  2282.             errno = EBUSY;
  2283.         else if (instr(buf,"cannot access"))
  2284.             errno = EACCES;
  2285.         else
  2286.             errno = EPERM;
  2287.         goto say_zero;
  2288.         }
  2289.         else {    /* some mkdirs return no failure indication */
  2290.         tmps = str_get(st[1]);
  2291.         anum = (stat(tmps,&statbuf) >= 0);
  2292.         if (optype == O_RMDIR)
  2293.             anum = !anum;
  2294.         if (anum)
  2295.             errno = 0;
  2296.         else
  2297.             errno = EACCES;    /* a guess */
  2298.         value = (double)anum;
  2299.         }
  2300.         goto donumset;
  2301.     }
  2302.     else
  2303.         goto say_zero;
  2304. #endif
  2305.     case O_RMDIR:
  2306.     if (maxarg < 1)
  2307.         tmps = str_get(stab_val(defstab));
  2308.     else
  2309.         tmps = str_get(st[1]);
  2310. #ifdef TAINT
  2311.     taintproper("Insecure dependency in rmdir");
  2312. #endif
  2313. #ifdef HAS_RMDIR
  2314.     value = (double)(rmdir(tmps) >= 0);
  2315.     goto donumset;
  2316. #else
  2317.     (void)strcpy(buf,"rmdir ");
  2318.     goto one_liner;        /* see above in HAS_MKDIR */
  2319. #endif
  2320.     case O_GETPPID:
  2321. #ifdef HAS_GETPPID
  2322.     value = (double)getppid();
  2323.     goto donumset;
  2324. #else
  2325.     fatal("Unsupported function getppid");
  2326.     break;
  2327. #endif
  2328.     case O_GETPGRP:
  2329. #ifdef HAS_GETPGRP
  2330.     if (maxarg < 1)
  2331.         anum = 0;
  2332.     else
  2333.         anum = (int)str_gnum(st[1]);
  2334. #ifdef _POSIX_SOURCE
  2335.     if (anum != 0)
  2336.         fatal("POSIX getpgrp can't take an argument");
  2337.     value = (double)getpgrp();
  2338. #else
  2339.     value = (double)getpgrp(anum);
  2340. #endif
  2341.     goto donumset;
  2342. #else
  2343.     fatal("The getpgrp() function is unimplemented on this machine");
  2344.     break;
  2345. #endif
  2346.     case O_SETPGRP:
  2347. #ifdef HAS_SETPGRP
  2348.     argtype = (int)str_gnum(st[1]);
  2349.     anum = (int)str_gnum(st[2]);
  2350. #ifdef TAINT
  2351.     taintproper("Insecure dependency in setpgrp");
  2352. #endif
  2353.     value = (double)(setpgrp(argtype,anum) >= 0);
  2354.     goto donumset;
  2355. #else
  2356.     fatal("The setpgrp() function is unimplemented on this machine");
  2357.     break;
  2358. #endif
  2359.     case O_GETPRIORITY:
  2360. #ifdef HAS_GETPRIORITY
  2361.     argtype = (int)str_gnum(st[1]);
  2362.     anum = (int)str_gnum(st[2]);
  2363.     value = (double)getpriority(argtype,anum);
  2364.     goto donumset;
  2365. #else
  2366.     fatal("The getpriority() function is unimplemented on this machine");
  2367.     break;
  2368. #endif
  2369.     case O_SETPRIORITY:
  2370. #ifdef HAS_SETPRIORITY
  2371.     argtype = (int)str_gnum(st[1]);
  2372.     anum = (int)str_gnum(st[2]);
  2373.     optype = (int)str_gnum(st[3]);
  2374. #ifdef TAINT
  2375.     taintproper("Insecure dependency in setpriority");
  2376. #endif
  2377.     value = (double)(setpriority(argtype,anum,optype) >= 0);
  2378.     goto donumset;
  2379. #else
  2380.     fatal("The setpriority() function is unimplemented on this machine");
  2381.     break;
  2382. #endif
  2383.     case O_CHROOT:
  2384. #ifdef HAS_CHROOT
  2385.     if (maxarg < 1)
  2386.         tmps = str_get(stab_val(defstab));
  2387.     else
  2388.         tmps = str_get(st[1]);
  2389. #ifdef TAINT
  2390.     taintproper("Insecure dependency in chroot");
  2391. #endif
  2392.     value = (double)(chroot(tmps) >= 0);
  2393.     goto donumset;
  2394. #else
  2395.     fatal("Unsupported function chroot");
  2396.     break;
  2397. #endif
  2398.     case O_FCNTL:
  2399.     case O_IOCTL:
  2400.     if (maxarg <= 0)
  2401.         stab = last_in_stab;
  2402.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  2403.         stab = arg[1].arg_ptr.arg_stab;
  2404.     else
  2405.         stab = stabent(str_get(st[1]),TRUE);
  2406.     argtype = U_I(str_gnum(st[2]));
  2407. #ifdef TAINT
  2408.     taintproper("Insecure dependency in ioctl");
  2409. #endif
  2410.     anum = do_ctl(optype,stab,argtype,st[3]);
  2411.     if (anum == -1)
  2412.         goto say_undef;
  2413.     if (anum != 0) {
  2414.         value = (double)anum;
  2415.         goto donumset;
  2416.     }
  2417.     str_set(str,"0 but true");
  2418.     STABSET(str);
  2419.     break;
  2420.     case O_FLOCK:
  2421. #ifdef HAS_FLOCK
  2422.     if (maxarg <= 0)
  2423.         stab = last_in_stab;
  2424.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  2425.         stab = arg[1].arg_ptr.arg_stab;
  2426.     else
  2427.         stab = stabent(str_get(st[1]),TRUE);
  2428.     if (stab && stab_io(stab))
  2429.         fp = stab_io(stab)->ifp;
  2430.     else
  2431.         fp = Nullfp;
  2432.     if (fp) {
  2433.         argtype = (int)str_gnum(st[2]);
  2434.         value = (double)(flock(fileno(fp),argtype) >= 0);
  2435.     }
  2436.     else
  2437.         value = 0;
  2438.     goto donumset;
  2439. #else
  2440.     fatal("The flock() function is unimplemented on this machine");
  2441.     break;
  2442. #endif
  2443.     case O_UNSHIFT:
  2444.     ary = stab_array(arg[1].arg_ptr.arg_stab);
  2445.     if (arglast[2] - arglast[1] != 1)
  2446.         do_unshift(ary,arglast);
  2447.     else {
  2448.         STR *tmpstr = Str_new(52,0);    /* must copy the STR */
  2449.         str_sset(tmpstr,st[2]);
  2450.         aunshift(ary,1);
  2451.         (void)astore(ary,0,tmpstr);
  2452.     }
  2453.     value = (double)(ary->ary_fill + 1);
  2454.     goto donumset;
  2455.  
  2456.  
  2457.     case O_TRY:
  2458.     sp = do_try(arg[1].arg_ptr.arg_cmd,
  2459.         gimme,arglast);
  2460.     goto array_return;
  2461.  
  2462.  
  2463.     case O_EVALONCE:
  2464.     sp = do_eval(st[1], O_EVAL, curcmd->c_stash, TRUE,
  2465.         gimme,arglast);
  2466.     if (eval_root) {
  2467.         str_free(arg[1].arg_ptr.arg_str);
  2468.         arg[1].arg_ptr.arg_cmd = eval_root;
  2469.         arg[1].arg_type = (A_CMD|A_DONT);
  2470.         arg[0].arg_type = O_TRY;
  2471.     }
  2472.     goto array_return;
  2473.  
  2474.  
  2475.     case O_REQUIRE:
  2476.     case O_DOFILE:
  2477.     case O_EVAL:
  2478.     if (maxarg < 1)
  2479.         tmpstr = stab_val(defstab);
  2480.     else
  2481.         tmpstr =
  2482.           (arg[1].arg_type & A_MASK) != A_NULL ? st[1] : stab_val(defstab);
  2483. #ifdef TAINT
  2484.     tainted |= tmpstr->str_tainted;
  2485.     taintproper("Insecure dependency in eval");
  2486. #endif
  2487.     sp = do_eval(tmpstr, optype, curcmd->c_stash, FALSE,
  2488.         gimme,arglast);
  2489.     goto array_return;
  2490.  
  2491.  
  2492.     case O_FTRREAD:
  2493.     argtype = 0;
  2494.     anum = S_IRUSR;
  2495.     goto check_perm;
  2496.     case O_FTRWRITE:
  2497.     argtype = 0;
  2498.     anum = S_IWUSR;
  2499.     goto check_perm;
  2500.     case O_FTREXEC:
  2501.     argtype = 0;
  2502.     anum = S_IXUSR;
  2503.     goto check_perm;
  2504.     case O_FTEREAD:
  2505.     argtype = 1;
  2506.     anum = S_IRUSR;
  2507.     goto check_perm;
  2508.     case O_FTEWRITE:
  2509.     argtype = 1;
  2510.     anum = S_IWUSR;
  2511.     goto check_perm;
  2512.     case O_FTEEXEC:
  2513.     argtype = 1;
  2514.     anum = S_IXUSR;
  2515.       check_perm:
  2516.     if (mystat(arg,st[1]) < 0)
  2517.         goto say_undef;
  2518.     if (cando(anum,argtype,&statcache))
  2519.         goto say_yes;
  2520.     goto say_no;
  2521.  
  2522.  
  2523.     case O_FTIS:
  2524.     if (mystat(arg,st[1]) < 0)
  2525.         goto say_undef;
  2526.     goto say_yes;
  2527.     case O_FTEOWNED:
  2528.     case O_FTROWNED:
  2529.     if (mystat(arg,st[1]) < 0)
  2530.         goto say_undef;
  2531.     if (statcache.st_uid == (optype == O_FTEOWNED ? euid : uid) )
  2532.         goto say_yes;
  2533.     goto say_no;
  2534.     case O_FTZERO:
  2535.     if (mystat(arg,st[1]) < 0)
  2536.         goto say_undef;
  2537.     if (!statcache.st_size)
  2538.         goto say_yes;
  2539.     goto say_no;
  2540.     case O_FTSIZE:
  2541.     if (mystat(arg,st[1]) < 0)
  2542.         goto say_undef;
  2543.     value = (double)statcache.st_size;
  2544.     goto donumset;
  2545.  
  2546.  
  2547.     case O_FTMTIME:
  2548.     if (mystat(arg,st[1]) < 0)
  2549.         goto say_undef;
  2550.     value = (double)(basetime - statcache.st_mtime) / 86400.0;
  2551.     goto donumset;
  2552.     case O_FTATIME:
  2553.     if (mystat(arg,st[1]) < 0)
  2554.         goto say_undef;
  2555.     value = (double)(basetime - statcache.st_atime) / 86400.0;
  2556.     goto donumset;
  2557.     case O_FTCTIME:
  2558.     if (mystat(arg,st[1]) < 0)
  2559.         goto say_undef;
  2560.     value = (double)(basetime - statcache.st_ctime) / 86400.0;
  2561.     goto donumset;
  2562.  
  2563.  
  2564.     case O_FTSOCK:
  2565.     if (mystat(arg,st[1]) < 0)
  2566.         goto say_undef;
  2567.     if (S_ISSOCK(statcache.st_mode))
  2568.         goto say_yes;
  2569.     goto say_no;
  2570.     case O_FTCHR:
  2571.     if (mystat(arg,st[1]) < 0)
  2572.         goto say_undef;
  2573.     if (S_ISCHR(statcache.st_mode))
  2574.         goto say_yes;
  2575.     goto say_no;
  2576.     case O_FTBLK:
  2577.     if (mystat(arg,st[1]) < 0)
  2578.         goto say_undef;
  2579.     if (S_ISBLK(statcache.st_mode))
  2580.         goto say_yes;
  2581.     goto say_no;
  2582.     case O_FTFILE:
  2583.     if (mystat(arg,st[1]) < 0)
  2584.         goto say_undef;
  2585.     if (S_ISREG(statcache.st_mode))
  2586.         goto say_yes;
  2587.     goto say_no;
  2588.     case O_FTDIR:
  2589.     if (mystat(arg,st[1]) < 0)
  2590.         goto say_undef;
  2591.     if (S_ISDIR(statcache.st_mode))
  2592.         goto say_yes;
  2593.     goto say_no;
  2594.     case O_FTPIPE:
  2595.     if (mystat(arg,st[1]) < 0)
  2596.         goto say_undef;
  2597.     if (S_ISFIFO(statcache.st_mode))
  2598.         goto say_yes;
  2599.     goto say_no;
  2600.     case O_FTLINK:
  2601.     if (mylstat(arg,st[1]) < 0)
  2602.         goto say_undef;
  2603.     if (S_ISLNK(statcache.st_mode))
  2604.         goto say_yes;
  2605.     goto say_no;
  2606.     case O_SYMLINK:
  2607. #ifdef HAS_SYMLINK
  2608.     tmps = str_get(st[1]);
  2609.     tmps2 = str_get(st[2]);
  2610. #ifdef TAINT
  2611.     taintproper("Insecure dependency in symlink");
  2612. #endif
  2613.     value = (double)(symlink(tmps,tmps2) >= 0);
  2614.     goto donumset;
  2615. #else
  2616.     fatal("Unsupported function symlink");
  2617. #endif
  2618.     case O_READLINK:
  2619. #ifdef HAS_SYMLINK
  2620.     if (maxarg < 1)
  2621.         tmps = str_get(stab_val(defstab));
  2622.     else
  2623.         tmps = str_get(st[1]);
  2624.     anum = readlink(tmps,buf,sizeof buf);
  2625.     if (anum < 0)
  2626.         goto say_undef;
  2627.     str_nset(str,buf,anum);
  2628.     break;
  2629. #else
  2630.     goto say_undef;        /* just pretend it's a normal file */
  2631. #endif
  2632.     case O_FTSUID:
  2633. #ifdef S_ISUID
  2634.     anum = S_ISUID;
  2635.     goto check_xid;
  2636. #else
  2637.     goto say_no;
  2638. #endif
  2639.     case O_FTSGID:
  2640. #ifdef S_ISGID
  2641.     anum = S_ISGID;
  2642.     goto check_xid;
  2643. #else
  2644.     goto say_no;
  2645. #endif
  2646.     case O_FTSVTX:
  2647. #ifdef S_ISVTX
  2648.     anum = S_ISVTX;
  2649. #else
  2650.     goto say_no;
  2651. #endif
  2652.       check_xid:
  2653.     if (mystat(arg,st[1]) < 0)
  2654.         goto say_undef;
  2655.     if (statcache.st_mode & anum)
  2656.         goto say_yes;
  2657.     goto say_no;
  2658.     case O_FTTTY:
  2659.     if (arg[1].arg_type & A_DONT) {
  2660.         stab = arg[1].arg_ptr.arg_stab;
  2661.         tmps = "";
  2662.     }
  2663.     else
  2664.         stab = stabent(tmps = str_get(st[1]),FALSE);
  2665.     if (stab && stab_io(stab) && stab_io(stab)->ifp)
  2666.         anum = fileno(stab_io(stab)->ifp);
  2667.     else if (isDIGIT(*tmps))
  2668.         anum = atoi(tmps);
  2669.     else
  2670.         goto say_undef;
  2671.     if (isatty(anum))
  2672.         goto say_yes;
  2673.     goto say_no;
  2674.     case O_FTTEXT:
  2675.     case O_FTBINARY:
  2676.     str = do_fttext(arg,st[1]);
  2677.     break;
  2678. #ifdef HAS_SOCKET
  2679.     case O_SOCKET:
  2680.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2681.         stab = arg[1].arg_ptr.arg_stab;
  2682.     else
  2683.         stab = stabent(str_get(st[1]),TRUE);
  2684. #ifndef lint
  2685.     value = (double)do_socket(stab,arglast);
  2686. #else
  2687.     (void)do_socket(stab,arglast);
  2688. #endif
  2689.     goto donumset;
  2690.     case O_BIND:
  2691.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2692.         stab = arg[1].arg_ptr.arg_stab;
  2693.     else
  2694.         stab = stabent(str_get(st[1]),TRUE);
  2695. #ifndef lint
  2696.     value = (double)do_bind(stab,arglast);
  2697. #else
  2698.     (void)do_bind(stab,arglast);
  2699. #endif
  2700.     goto donumset;
  2701.     case O_CONNECT:
  2702.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2703.         stab = arg[1].arg_ptr.arg_stab;
  2704.     else
  2705.         stab = stabent(str_get(st[1]),TRUE);
  2706. #ifndef lint
  2707.     value = (double)do_connect(stab,arglast);
  2708. #else
  2709.     (void)do_connect(stab,arglast);
  2710. #endif
  2711.     goto donumset;
  2712.     case O_LISTEN:
  2713.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2714.         stab = arg[1].arg_ptr.arg_stab;
  2715.     else
  2716.         stab = stabent(str_get(st[1]),TRUE);
  2717. #ifndef lint
  2718.     value = (double)do_listen(stab,arglast);
  2719. #else
  2720.     (void)do_listen(stab,arglast);
  2721. #endif
  2722.     goto donumset;
  2723.     case O_ACCEPT:
  2724.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2725.         stab = arg[1].arg_ptr.arg_stab;
  2726.     else
  2727.         stab = stabent(str_get(st[1]),TRUE);
  2728.     if ((arg[2].arg_type & A_MASK) == A_WORD)
  2729.         stab2 = arg[2].arg_ptr.arg_stab;
  2730.     else
  2731.         stab2 = stabent(str_get(st[2]),TRUE);
  2732.     do_accept(str,stab,stab2);
  2733.     STABSET(str);
  2734.     break;
  2735.     case O_GHBYNAME:
  2736.     if (maxarg < 1)
  2737.         goto say_undef;
  2738.     case O_GHBYADDR:
  2739.     case O_GHOSTENT:
  2740.     sp = do_ghent(optype,
  2741.       gimme,arglast);
  2742.     goto array_return;
  2743.     case O_GNBYNAME:
  2744.     if (maxarg < 1)
  2745.         goto say_undef;
  2746.     case O_GNBYADDR:
  2747.     case O_GNETENT:
  2748.     sp = do_gnent(optype,
  2749.       gimme,arglast);
  2750.     goto array_return;
  2751.     case O_GPBYNAME:
  2752.     if (maxarg < 1)
  2753.         goto say_undef;
  2754.     case O_GPBYNUMBER:
  2755.     case O_GPROTOENT:
  2756.     sp = do_gpent(optype,
  2757.       gimme,arglast);
  2758.     goto array_return;
  2759.     case O_GSBYNAME:
  2760.     if (maxarg < 1)
  2761.         goto say_undef;
  2762.     case O_GSBYPORT:
  2763.     case O_GSERVENT:
  2764.     sp = do_gsent(optype,
  2765.       gimme,arglast);
  2766.     goto array_return;
  2767.     case O_SHOSTENT:
  2768.     value = (double) sethostent((int)str_gnum(st[1]));
  2769.     goto donumset;
  2770.     case O_SNETENT:
  2771.     value = (double) setnetent((int)str_gnum(st[1]));
  2772.     goto donumset;
  2773.     case O_SPROTOENT:
  2774.     value = (double) setprotoent((int)str_gnum(st[1]));
  2775.     goto donumset;
  2776.     case O_SSERVENT:
  2777.     value = (double) setservent((int)str_gnum(st[1]));
  2778.     goto donumset;
  2779.     case O_EHOSTENT:
  2780.     value = (double) endhostent();
  2781.     goto donumset;
  2782.     case O_ENETENT:
  2783.     value = (double) endnetent();
  2784.     goto donumset;
  2785.     case O_EPROTOENT:
  2786.     value = (double) endprotoent();
  2787.     goto donumset;
  2788.     case O_ESERVENT:
  2789.     value = (double) endservent();
  2790.     goto donumset;
  2791.     case O_SOCKPAIR:
  2792.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2793.         stab = arg[1].arg_ptr.arg_stab;
  2794.     else
  2795.         stab = stabent(str_get(st[1]),TRUE);
  2796.     if ((arg[2].arg_type & A_MASK) == A_WORD)
  2797.         stab2 = arg[2].arg_ptr.arg_stab;
  2798.     else
  2799.         stab2 = stabent(str_get(st[2]),TRUE);
  2800. #ifndef lint
  2801.     value = (double)do_spair(stab,stab2,arglast);
  2802. #else
  2803.     (void)do_spair(stab,stab2,arglast);
  2804. #endif
  2805.     goto donumset;
  2806.     case O_SHUTDOWN:
  2807.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2808.         stab = arg[1].arg_ptr.arg_stab;
  2809.     else
  2810.         stab = stabent(str_get(st[1]),TRUE);
  2811. #ifndef lint
  2812.     value = (double)do_shutdown(stab,arglast);
  2813. #else
  2814.     (void)do_shutdown(stab,arglast);
  2815. #endif
  2816.     goto donumset;
  2817.     case O_GSOCKOPT:
  2818.     case O_SSOCKOPT:
  2819.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2820.         stab = arg[1].arg_ptr.arg_stab;
  2821.     else
  2822.         stab = stabent(str_get(st[1]),TRUE);
  2823.     sp = do_sopt(optype,stab,arglast);
  2824.     goto array_return;
  2825.     case O_GETSOCKNAME:
  2826.     case O_GETPEERNAME:
  2827.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2828.         stab = arg[1].arg_ptr.arg_stab;
  2829.     else
  2830.         stab = stabent(str_get(st[1]),TRUE);
  2831.     if (!stab)
  2832.         goto say_undef;
  2833.     sp = do_getsockname(optype,stab,arglast);
  2834.     goto array_return;
  2835.  
  2836.  
  2837. #else /* HAS_SOCKET not defined */
  2838.     case O_SOCKET:
  2839.     case O_BIND:
  2840.     case O_CONNECT:
  2841.     case O_LISTEN:
  2842.     case O_ACCEPT:
  2843.     case O_SOCKPAIR:
  2844.     case O_GHBYNAME:
  2845.     case O_GHBYADDR:
  2846.     case O_GHOSTENT:
  2847.     case O_GNBYNAME:
  2848.     case O_GNBYADDR:
  2849.     case O_GNETENT:
  2850.     case O_GPBYNAME:
  2851.     case O_GPBYNUMBER:
  2852.     case O_GPROTOENT:
  2853.     case O_GSBYNAME:
  2854.     case O_GSBYPORT:
  2855.     case O_GSERVENT:
  2856.     case O_SHOSTENT:
  2857.     case O_SNETENT:
  2858.     case O_SPROTOENT:
  2859.     case O_SSERVENT:
  2860.     case O_EHOSTENT:
  2861.     case O_ENETENT:
  2862.     case O_EPROTOENT:
  2863.     case O_ESERVENT:
  2864.     case O_SHUTDOWN:
  2865.     case O_GSOCKOPT:
  2866.     case O_SSOCKOPT:
  2867.     case O_GETSOCKNAME:
  2868.     case O_GETPEERNAME:
  2869.       badsock:
  2870.     fatal("Unsupported socket function");
  2871. #endif /* HAS_SOCKET */
  2872.     case O_SSELECT:
  2873. #ifdef HAS_SELECT
  2874.     sp = do_select(gimme,arglast);
  2875.     goto array_return;
  2876. #else
  2877.     fatal("select not implemented");
  2878. #endif
  2879.     case O_FILENO:
  2880.     if (maxarg < 1)
  2881.         goto say_undef;
  2882.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2883.         stab = arg[1].arg_ptr.arg_stab;
  2884.     else
  2885.         stab = stabent(str_get(st[1]),TRUE);
  2886.     if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
  2887.         goto say_undef;
  2888.     value = fileno(fp);
  2889.     goto donumset;
  2890.     case O_BINMODE:
  2891.     if (maxarg < 1)
  2892.         goto say_undef;
  2893.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2894.         stab = arg[1].arg_ptr.arg_stab;
  2895.     else
  2896.         stab = stabent(str_get(st[1]),TRUE);
  2897.     if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
  2898.         goto say_undef;
  2899. #ifdef MSDOS
  2900.     str_set(str, (setmode(fileno(fp), O_BINARY) != -1) ? Yes : No);
  2901. #else
  2902.     str_set(str, Yes);
  2903. #endif
  2904.     STABSET(str);
  2905.     break;
  2906.     case O_VEC:
  2907.     sp = do_vec(str == st[1], arg->arg_ptr.arg_str, arglast);
  2908.     goto array_return;
  2909.     case O_GPWNAM:
  2910.     case O_GPWUID:
  2911.     case O_GPWENT:
  2912. #ifdef HAS_PASSWD
  2913.     sp = do_gpwent(optype,
  2914.       gimme,arglast);
  2915.     goto array_return;
  2916.     case O_SPWENT:
  2917.     value = (double) setpwent();
  2918.     goto donumset;
  2919.     case O_EPWENT:
  2920.     value = (double) endpwent();
  2921.     goto donumset;
  2922. #else
  2923.     case O_EPWENT:
  2924.     case O_SPWENT:
  2925.     fatal("Unsupported password function");
  2926.     break;
  2927. #endif
  2928.     case O_GGRNAM:
  2929.     case O_GGRGID:
  2930.     case O_GGRENT:
  2931. #ifdef HAS_GROUP
  2932.     sp = do_ggrent(optype,
  2933.       gimme,arglast);
  2934.     goto array_return;
  2935.     case O_SGRENT:
  2936.     value = (double) setgrent();
  2937.     goto donumset;
  2938.     case O_EGRENT:
  2939.     value = (double) endgrent();
  2940.     goto donumset;
  2941. #else
  2942.     case O_EGRENT:
  2943.     case O_SGRENT:
  2944.     fatal("Unsupported group function");
  2945.     break;
  2946. #endif
  2947.     case O_GETLOGIN:
  2948. #ifdef HAS_GETLOGIN
  2949.     if (!(tmps = getlogin()))
  2950.         goto say_undef;
  2951.     str_set(str,tmps);
  2952. #else
  2953.     fatal("Unsupported function getlogin");
  2954. #endif
  2955.     break;
  2956.     case O_OPEN_DIR:
  2957.     case O_READDIR:
  2958.     case O_TELLDIR:
  2959.     case O_SEEKDIR:
  2960.     case O_REWINDDIR:
  2961.     case O_CLOSEDIR:
  2962.     if (maxarg < 1)
  2963.         goto say_undef;
  2964.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2965.         stab = arg[1].arg_ptr.arg_stab;
  2966.     else
  2967.         stab = stabent(str_get(st[1]),TRUE);
  2968.     if (!stab)
  2969.         goto say_undef;
  2970.     sp = do_dirop(optype,stab,gimme,arglast);
  2971.     goto array_return;
  2972.     case O_SYSCALL:
  2973.     value = (double)do_syscall(arglast);
  2974.     goto donumset;
  2975.     case O_PIPE:
  2976. #ifdef HAS_PIPE
  2977.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2978.         stab = arg[1].arg_ptr.arg_stab;
  2979.     else
  2980.         stab = stabent(str_get(st[1]),TRUE);
  2981.     if ((arg[2].arg_type & A_MASK) == A_WORD)
  2982.         stab2 = arg[2].arg_ptr.arg_stab;
  2983.     else
  2984.         stab2 = stabent(str_get(st[2]),TRUE);
  2985.     do_pipe(str,stab,stab2);
  2986.     STABSET(str);
  2987. #else
  2988.     fatal("Unsupported function pipe");
  2989. #endif
  2990.     break;
  2991.     }
  2992.  
  2993.  
  2994.   normal_return:
  2995.     st[1] = str;
  2996. #ifdef DEBUGGING
  2997.     if (debug) {
  2998.     dlevel--;
  2999.     if (debug & 8)
  3000.         deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str));
  3001.     }
  3002. #endif
  3003.     return arglast[0] + 1;
  3004. }
  3005.